Cream of the Crop 22/Cream of the Crop 22.iso/program/abc9609.zip/ABC9609.CDE

Text File | 1996-08-31 | 1MB | 1 lines

Kurt Kuzba                     BRESENHAM LINE/CIRCLE ALGORITHMFidoNet QUIK_BAS Echo          04-16-96 (00:00)       QB, QBasic, PDS        73   2314     BRESNHAM.BAS'_|_|_|   BRESNHAM.BASπ'_|_|_|   This program demonstrates the Bresenham Algorithmsπ'_|_|_|   for the drawing of lines and circles, using PSET.π'_|_|_|   Adapted from BRESNHAM.C in Bob Stout's SNIPPETS.π'_|_|_|   No warrantee or guarantee is implied or given.π'_|_|_|   Released to   PUBLIC DOMAIN   by Kurt Kuzba. (4/16/96)πDECLARE SUB BLine (x%, y%, x2%, y2%, c%)πDECLARE SUB BCircle (x%, y%, r%, c%)πSCREEN 13πHIGH% = 200   'The Bresenham Cirlce will need to know the screenπWIDE% = 320   'dimensions, which are found in these SHARED variablesπndx% = 0πRANDOMIZE (TIMER * 100 + INP(64))πDIM xy(412) AS LONGπBCircle 159, 99, 65, 77πDEF SEG = &HA000πFOR t& = 0 TO 63999π   IF PEEK(t&) = 77 THEN xy(ndx%) = t&: ndx% = ndx% + 1πNEXT:πWHILE INKEY$ = ""π   BCircle 159, 99, RND * 129 + 70, RND * 255π   ndx% = (RND * 400 + 5)π   l1& = xy(ndx%)π   x1% = l1& MOD 320π   y1% = l1& \ 320π   l2& = xy(ndx% + 3)π   x2% = l2& MOD 320π   y2% = l2& \ 320π   BLine x1%, y1%, x2%, y2%, RND * 255πWENDπSOUND 999, 1πWHILE INKEY$ = "": WENDπSCREEN 0πWIDTH 80, 25πENDπSUB BCircle (xc%, yc%, r%, c%)π'_|_|_|   Bresenham Circle Drawing Algorithmπ'_|_|_|   Adapted from BRESNHAM.C in Bob Stout's SNIPPETS.π   SHARED WIDE%, HIGH%π   x% = 0: d% = 2 * (1 - r%): W% = 2 * WIDE% \ HIGH%π   WHILE r% >= 0π      PSET (xc% + x%, yc% + r%), c%π      PSET (xc% + x%, yc% - r%), c%π      PSET (xc% - x%, yc% + r%), c%π      PSET (xc% - x%, yc% - r%), c%π      IF (d% + r%) > 0 THEN r% = r% - 1: d% = d% - W% * r% - 1π      IF x% > d% THEN x% = x% + 1: d% = d% + 2 * x% + 1π   WENDπEND SUBπSUB BLine (x%, y%, x2%, y2%, c%)π'_|_|_|   Bresenham Line Drawing Algorithmπ'_|_|_|   Adapted from BRESNHAM.C in Bob Stout's SNIPPETS.π   i% = 0: steep% = 0: e% = 0π   IF (x2% - x%) > 0 THEN sx% = 1: ELSE sx% = -1π   dx% = ABS(x2% - x%)π   IF (y2% - y%) > 0 THEN sy% = 1:  ELSE sy% = -1π   dy% = ABS(y2% - y%)π   IF (dy% > dx%) THENπ      steep% = 1π      SWAP x%, y%π      SWAP dx%, dy%π      SWAP sx%, sy%π   END IFπ   e% = 2 * dy% - dx%π   FOR i% = 0 TO dx% - 1π      IF steep% = 1 THEN PSET (y%, x%), c%:  ELSE PSET (x%, y%), c%π      WHILE e% >= 0π         y% = y% + sy%: e% = e% - 2 * dx%π      WENDπ      x% = x% + sx%: e% = e% + 2 * dy%π   NEXTπ   PSET (x2%, y2%), c%πEND SUBπTyler Barnes                   BASE CONVERSION ROUTINE        [e-mail].b07-28-96 (12:32)       QB, QBasic, PDS        47   1659     BASE.BAS    'A lot of the code in this sub is extraneous, and is only put there to speed things up.ππ'If you don't know how to use this, just email me at [e-mail]ππDECLARE SUB Base2Base (Number1$, Digits1$, Number2$, Digits2$)πCONST Bin = "01", Oct = "01234567", Dec = "0123456789", Hex = "0123456789ABCDEF"ππDEFLNG A-ZπSUB Base2Base (Number1$, Digits1$, Number2$, Digits2$)πNumber1$ = UCASE$(Number1$): Digits1$ = UCASE$(Digits1$)πDigits2$ = UCASE$(Digits2$)πIF Digits1$ <> "0123456789" THENπFOR I% = LEN(Number1$) TO 1 STEP -1πIF Digits1$ = "01234567" THEN FinalNum = VAL("&O" + Number1$): I% = 1πIF Digits1$ = "0123456789ABCDEF" THEN FinalNum = VAL("&H" + Number1$): I% = 1πCD$ = MID$(Number1$, I%, 1)πCV% = INSTR(Digits1$, CD$) - 1πFinalNum = FinalNum + (CV% * (LEN(Digits1$) ^ ABS(I% - LEN(Number1$))))πNEXT I%πELSEπFinalNum = VAL(Number1$)πEND IFπIF Digits2$ = "0123456789" THEN Number2$ = LTRIM$(STR$(FinalNum)): EXIT SUBπIF Digits2$ = "0123456789ABCDEF" THEN Number2$ = HEX$(FinalNum): EXIT SUBπIF Digits2$ = "01234567" THEN Number2$ = OCT$(FinalNum): EXIT SUBπNumber2$ = "": NeverDone% = 1πLD2% = LEN(Digits2$)πDOπFOR I% = 1 TO LD2%πIT& = (I% - 1) * (LD2% ^ DPos%)πIF IT& > FinalNum THEN Z% = 1: I% = I% - 1πIF IT& = FinalNum OR Z% = 1 THENπIF Z% = 1 THENπIF I% = 1 THEN I% = LD2%: DPos% = DPos% - 1πEND IFπIF NeverDone% = 1 THEN NeverDone% = 0: N2$ = STRING$(DPos% + 1, "0")πMID$(N2$, LEN(N2$) - DPos%, 1) = MID$(Digits2$, I%, 1)πFinalNum = FinalNum - ((I% - 1) * (LD2% ^ DPos%))πDPos% = -1πZ% = 0πEXIT FORπEND IFπNEXT I%πDPos% = DPos% + 1πLOOP UNTIL FinalNum = 0πNumber2$ = N2$πEND SUBπM. Rosenberg                   PB HUFFMAN ENCODER             QBTIPS_T.DOC                   12-03-93 (15:30)       PB                     133  4759     HUFFMAN.BAS 'Hey all, well I a recently got a Hufman algrorithm for BASIC. Sadly itπ'was made only for PowerBasic and I use QuickBasic.  Could some of youπ'guys out there with both QB/PB experience possibly modify the code ??ππCLSπInFile$="A SIMPLE STRING TO BE ENCODED USING A MINIMAL NUMBER OF BITS"ππCALL Huffman(InFile$,OutFile$,NewFile$)πprint:print:printπPRINT "In:  ";LEN(InFile$);InFile$πPRINT "Out: ";LEN(OutFile$)πPRINT "New: ";LEN(NewFile$);NewFile$πinput,rππENDπ'**********************************************************************π'   Huffman Encoding File Compression Techniqueπ'π'   From: R Sedgwick.  Algorithms.  Reading, MA: Addison-Wesley.π'                      1984.  Second Ed.  pp  286 / 93.π'π'   Converted to Power Basic by M. Rosenberg CI$: [73707,2545]π'πSUB Huffman(InText$,OutText$,NewText$)π    SHARED N%,Heap%(),Count%()π    DIM Count%(1024),Heap%(1024),Dad%(1024),Code%(256),Leng%(256)ππ' Count the frequency of each character in the message to be encoded (P. 287)π    FOR I%=0 to 255 : Count%(I%)=0 : NEXT I%π    Csr%=0π    DO : INCR Csr% : X%=ASC(MID$(InText$,Csr%,1)) : INCR Count%(X%)π         LOOP UNTIL Csr%=LEN(InText$)ππ' Initialize the heap array to point to non-zero frequency counts (P. 290)ππ    N%=0 : FOR I%=0 to 255 : IF Count%(I%)<>0 THEN INCR N% : Heap%(N%)=I%π           NEXT I%π' Construct an indirect heap on the frequency values (P. 289)ππ    FOR K% = N% TO 1 STEP -1 : CALL PqDownHeap(K%) : NEXT K%ππ' Construct the trie (P. 290)π    DO : T%=Heap%(1) : Heap%(1)=Heap%(N%) : DECR N%π             CALL PqDownHeap(1)π             Count%(255+N%)=Count%(Heap%(1))+Count%(T%)π             Dad%(T%)=255+N% : Dad%(Heap%(1))=-255-N%π             Heap%(1)=255+N% : CALL PqDownHeap(1)π    LOOP UNTIL N%=1π    Dad%(255+N%)=0ππ' Reconstruct the information from the representation of the coding tree (P.291)π'    computed during the sifting process.ππ    FOR K% = 0 TO 255π        IF Count%(K%)=0 THENπ           Code%(K%)=0 : Leng%(K%)=0π        ELSEπ           I%=0 : J&=1 : T%=Dad%(K%) : X%=0π           DO : IF T%<0 THEN X%=X%+J& : T%=0-T%π                T%=Dad%(T%) : J&=J&+J& : INCR I%π           LOOP UNTIL T%=0π           Code%(K%)=X% : Leng%(K%)=I%π        END IFπ    NEXT K%π' Use the computed representations of the code to encode the string (P. 292)ππ    J%=0 : OutText$="" : Hold$=""π    DO : INCR J%π             Char%=ASC(MID$(InText$,J%,1)) : Compr$=BIN$(Code%(Char%))π             DO WHILE LEN(Compr$)< Leng%(Char%) : Compr$="0"+Compr$ : LOOPπ             Hold$=Hold$+Compr$π             IF LEN(Hold$)>8 THENπ                          π                OutText$=OutText$+CHR$(Bin2Int(LEFT$(Hold$,8))) Hold$=RIGHT$(Hold$,LEN(Hold$)-8)π             END IFπ    LOOP UNTIL J%=LEN(InText$)ππ' Add a byte at the end that contains any left-over bitsππ    IF LEN(Hold$)>0 THENπ             Hold$=Hold$+STRING$(8-LEN(Hold$),"0")π             OutText$=OutText$+CHR$(Bin2Int(LEFT$(Hold$,8)))π    END IFπ'**********************************************************************π' Unpack compressed string into character representation of binaryππ    J%=0 : UnCompr$="" : NewText$=""π    DO : INCR J%π         Hold$=MID$(OutText$,J%,1) : Hold$=BIN$(ASC(Hold$))π         DO WHILE LEN(Hold$)<8 : Hold$="0"+Hold$ : LOOPπ         UnCompr$=UnCompr$+Hold$π    LOOP UNTIL J%=LEN(OutText$)ππ' Decode compressed stringππ    DO : FOR  K%=1 TO 256π         IF K%=256 THEN EXIT LOOP 'All doneπ         IF Leng%(K%)>0 THENπ            IF Bin2Int(LEFT$(UnCompr$,Leng%(K%)))=Code%(K%) THENπ                                                                     π               UnCompr$=RIGHT$(UnCompr$,LEN(UnCompr$)-Leng%(K%))π               NewText$=NewText$+CHR$(K%) : EXIT FORπ            END IFπ        END IFπ        NEXT K%π    LOOP UNTIL LEN(UnCompr$) = 0πππEND SUB 'HuffmanππSUB PqDownHeap(K%)π' Build and maintain an indirect heap on the frequency values (P. 139)π'     reversing the inequalities since we want the smallest values first.ππ    SHARED N%,Heap%(),Count%()π    LOCAL J%,V%,Limit%π    V%=Heap%(K%) : Limit% = N%/2π    DO WHILE K% <= Limit%π       J%=K%+K%π       IF J%<N% THEN IF Count%(Heap%(J%)) > Count%(Heap%(J%+1)) THEN INCR J%π       IF Count%(V%)<=Count%(Heap%(J%)) THEN Heap%(K%)=V% : EXIT SUBπ       Heap%(K%)=Heap%(J%) : Heap%(J%)=V% : K%=J%π    LOOPπEND SUB 'PqDownHeapππ'**********************************************************************πFUNCTION Bin2Int(X$)πX$=RTRIM$(X$) :X$=LTRIM$(X$) : Ll%=LEN(X$) : Ex%=0 : Tot%=0 : I%=Ll%π    DO WHILE I% > 0π        IF MID$(X$,I%,1)="1" THEN Tot&=Tot&+(2^Ex&)π        INCR Ex& : DECR I% : WENDπ    Bin2Int=Tot&πEND FUNCTION 'Bin2IntπFranklin Villamor              NUMBER OF POSSIBLE [e-mail]           08-25-96 (22:38)       QB, QBasic, PDS        17   545      COMBINAT.BASTo find out how many possibilities there can be:ππclsπinput "Number of different states for each object: ", aπinput "Number of objects: ", bππfor x = 0 to b - 1πc = c + a^xπnext xππprint "Number of possibilities: ", cππImagine a row of four sheets of paper. Each paper can be in one of twoπstates, either the blank side, or the written on side. The variable "a" isπthe number of states (in this case 2). The variable "b" is the number ofπobjects (in this case 4). This will have 15 different unique combinationsπ(which is "c").πStuart McLachlan               ENVIRONMENT PATHNAME           comp.lang.basic.misc           07-11-96 (16:56)       ASIC                   32   791      PATH.ASI    Rem Get Program Segment Prefix Addressπ    Ax=&Hex6200π    Int86(&Hex21,Ax,Bx,Na,Na,Na,Na,Na,Na,Na)π    Defseg = BxππRem Get Address Of Environment Blockπ    Lo = Peek(&Hex2c)π    Hi = Peek(&Hex2d)π    Env = Hi * 256π    Env = Env + Loπ    Defseg = EnvππRem Get Environment Lengthπ    For Environment = 0 To 511π       Temp=Peek(Environment)π       If Temp = 1 Thenπ           Locationstart = Environment + 2π           Environment = 511π       Endifπ    Next EnvironmentππRem Get File Location Dataπ   For Filelocation = Locationstart To 511π      Temp = Peek(Filelocation)π      If Temp <> 0 Thenπ         Nextstring$ = Chr$(Temp)π        Fileloc$ = Fileloc$ + Nextstring$π      Elseπ      Filelocation = 511π      Endifπ   Next FilelocationπPrint Fileloc$πDaniel Garlans                 DEBUG ASM CONVERTER            [e-mail]       07-29-96 (17:10)       QB, QBasic, PDS        116  6028     DEBUGASM.BAS'DEBUG ASM Converter Version 1.0a Rewrite 1 π'Written by: White Shade of DuoTech π'(Real Name: Daniel Garlans) π'This program is freeware. π'You may use this code any way you like, just give me credit =] π'Information on conversion from a FAQ by Ian Muskgrave (sorry if I misspelled) π'My E-Mail Address: [e-mail] π'This converts DEBUG-ASM (debug < name.dbg > out.asm) into CALL ABSOLUTE strings π'and saves them and code for use into an out file. π'This is rewrite 1 because my first version was written at about 9:30 to 10:30 pm π'and I was tired and so it was huge, messy and wasn't working, so the next day π'I wrote it entirely from scratch :) π'Absolutly needed in the file to convert from: π'-U in a line to show where the HEX Code output started and -Q in a line toππ'show what line the output ends on. Format of a converted line in result file: π'ASM$=ASM$+whatevertoadd 'offset = xxxx:xxxx hex code:whateverthehexis π'the ASM$ can be changed to whatever. π'Sub Cp prints t$ in the center of row l! in 80 column text mode. π'Have fun with this :) It's fully commented. π'you can do whatever you want with it... π'THINGS 2 KNOW: No error handling...Still some optimizing to do...quite fast... π'can convert something like a 16k file (I don't have anything that big to test with) π πDECLARE SUB Cp (t$, l!) πCLS π'print a headline :) πCOLOR 15, 1 'set background to dark blue, foreground to bright white πLOCATE 1, 1: PRINT STRING$(80, " ") 'make first line be all dark blue πCALL Cp("DebugASM Converter 1.0a", 1) 'use Cp to write the text to the center πCOLOR 7, 0 'make colors normal πINPUT "File to Convert:"; a$: file$ = UCASE$(a$) 'get filename and make it uppercase πINPUT "File to write to:"; a$: outfile$ = UCASE$(a$)'get output name and make it uppercase πINPUT "String to write to:"; a$: cnme$ = UCASE$(a$)'get string name in output file and make it uppercase πPRINT " Converting: " + file$               'display info πPRINT " Saving output to: " + outfile$      'ditto πPRINT " Converted Code String: " + cnme$    'ditto πOPEN file$ FOR INPUT AS #1 'Open Files πOPEN outfile$ FOR OUTPUT AS #2 'Open Files πst = 0 'start pos... if still 0 after next block, error :) πen = 0'end pos...ditto πPRINT "Finding start of hex code values"; πDO WHILE NOT EOF(1) 'Loop until end of the file π  LINE INPUT #1, a$ 'get a line (commas etc allowed) π  c$ = UCASE$(a$) 'convert to uppercase π  IF INSTR(c$, "-U") THEN 'Is -U in it? (indicates start of hex code) π    st = v + 1 'If it is, make the start equal the next line in file π  END IF π  IF INSTR(c$, "-Q") THEN 'Is -Q in it? (indicates end of hex code) π    en = v 'If so, make end equal this line π    END IF π  PRINT "."; 'Display a dot to show that the proggy is working :) π  v = v + 1 'Increase current-line counter πLOOP 'duh :) πPRINT 'go to next line (because of the 'print ".";') πSEEK 1, 1 'Set current position in input file to first character (it was at the end) π'DIM lne$(1 TO v) 'Actually, This isn't needed...wonder what I was thinking.... :) πIF st = 0 OR en = 0 THEN 'Wait! If the start and end positions are STILL zero now, the program failed. π  PRINT "Error, -U or -Q not found. Unable to convert." π  CLOSE 'close files π  END 'duhh :) πEND IF π πPRINT "Moving to start of HEX code at line "; st πFOR a = 1 TO st 'loop until start line π  LINE INPUT #1, temp$ 'so the file pos is moved. πNEXT a πlnt = en - st 'amount of lines between -U and -Q πPRINT "Converting & Saving..." πFOR a = 1 TO lnt 'loop for the lines between -U and -Q π  LINE INPUT #1, a$ 'get the line to work on π  a$ = UCASE$(a$) 'make uppercase (for neatness in output) π  IF LEN(a$) > 0 THEN 'so it doesn't try to convert a blank line :) π    offse$ = LEFT$(a$, 9) 'Get Offset (always first 9 letters  xxxx:xxxx) π    toconv$ = MID$(a$, 11, 6) 'get the HEX Code to convert π    toconv$ = RTRIM$(toconv$) 'trim spaces from end π    toconv$ = LTRIM$(toconv$) '  "    "     "   start π    'dn = LEN(tonconv$) 'get length...whoops this isn't needed because... π    SELECT CASE LEN(toconv$) 'select case with the length      of this :) π      CASE 2 'maybe like CB (retf) π        fin$ = "CHR$(&H" + toconv$ + ")" 'Make the output string.. π      CASE 4 'maybe like CD33 (int 33h) π        one$ = LEFT$(toconv$, 2) 'get first two letters π        two$ = RIGHT$(toconv$, 2) 'get last two letters π        fin$ = "chr$(&H" + one$ + ") + chr$(&H" + two$ + ")" 'make output string π      CASE 6 'maybe like B80100 (mov ax,0001) π        one$ = LEFT$(toconv$, 2) 'get first two π        two$ = MID$(toconv$, 3, 2) 'get last two π        fin$ = "chr$(&H" + one$ + ") + chr$(&H" + two$ + ")" 'make output string π      CASE ELSE 'Prolly an error π        PRINT "Warning: Unknown hex string, cannot convert." π        fin$ = "" 'make output string be nothing. π    END SELECT π    IF LEN(fin$) <> 0 THEN 'do this only if the output string is more than nothing (see in CASE ELSE it sets FIN$ to nothing?) π      v$ = cnme$ + "=" + cnme$ + "+" + fin$ + " 'Offset=" + offse$ + " Hex Command= " + toconv$  'Assemble output string (see opening comments) π      PRINT #2, v$ 'write final final output string to the output file π    END IF π  END IF πNEXT a πPRINT "Writing info for code use..." π'next four lines write commented out code for the use of the converted code. πPRINT #2, "'These next commented lines are for using the converted code." πPRINT #2, "'DEF SEG=VARSEG(" + cnme$ + ")" πPRINT #2, "'theoff%=SADD(" + cnme$ + ")" πPRINT #2, "'CALL ABSOLUTE(theoff%)" πCLOSE 'close all file handles πPRINT "Conversion of Debug-Asm complete."' " + file$ + " to " + outfile$ + " in " + cnme$ 'give a little info πPRINT "Coding by: White Shade of DuoTech" 'More info πPRINT "This program is Freeware and may be freely distributed." 'and a little more.. πEND 'Terminate program :) π πSUB Cp (t$, l) π  v = 40 - (LEN(t$) / 2) π  LOCATE l, v π  PRINT t$ πEND SUB πPaul Kuliniewicz               ENIGMA CODING PROGRAM          home.aol.com/Borg953           07-10-96 (00:00)       QB, QBasic, PDS        761  26994    ECP.BAS     ' ***************************************************************************π' ***                       Enigma Coding Program                         ***π' ***************************************************************************π' written by Paul Kuliniewiczπ' version 1.0π' WARNING!  ANY TAMPERING WITH THIS FILE MAY CAUSE IT TO MALFUNCTION ANDπ' DAMAGE ANY FILES YOU WORK WITH!  THE AUTHOR IS NOT RESPONSIBLE FOR DAMAGEπ' CAUSED BY EDITING THIS FILE!π' This file is Public Domain.  You may distribute this file as you wishπ' freely, as long as the file has not been altered in any way.π' Notice to Windows Users: only run this file in FULL SCREEN!  (this fileπ' writes and reads directly to and from screen memory.  Running in a windowπ' may cause unexpected, and possibly dangerous, results)π' *** Prepare for Operation Routine ***πDECLARE SUB CenterText (text$)πDECLARE SUB Shadow (urr%, urc%, llr%, llc%, lrr%, lrc%)πDECLARE SUB LoadImage (showme%())πDECLARE SUB SaveImage (saveme%())πDECLARE SUB StatusLine (message$, sector$)πDECLARE FUNCTION MessWithByte$ (original$)πDECLARE FUNCTION PseudoNOT$ (bit$)πDECLARE FUNCTION MakeBinary$ (convert%)πDECLARE FUNCTION MakeDecimal% (byte$)πDECLARE FUNCTION ConvBlock% (row%, column%, colormem%)πDECLARE FUNCTION ConvColor% (fore%, back%)πDECLARE FUNCTION Character$ ()πCLEARπON ERROR GOTO HandleErrorπKEY OFFπCLSπ'$STATICπDIM mainimage%(0 TO 4001)πDIM screenimage%(0 TO 4001)πDIM mainstatus$(1 TO 6)πDIM helpstatus$(1 TO 6)πFOR counter% = 1 TO 6π  READ mainstatus$(counter%)πNEXT counter%πFOR counter% = 1 TO 6π  READ helpstatus$(counter%)πNEXT counter%πCONST TRUE = -1πCONST FALSE = 0πfirsttime% = FALSEπDEF SEG = &HB800π' *** Title Screen Display Routine ***πFOR counter% = ConvBlock%(1, 1, 1) TO ConvBlock%(24, 80, 1) STEP 2π  POKE counter%, ConvColor%(7, 1)πNEXT counter%πFOR counter% = ConvBlock%(25, 1, 1) TO ConvBlock%(25, 80, 1) STEP 2π  POKE counter%, ConvColor%(4, 7)πNEXT counter%πCOLOR 7, 1πLOCATE 4, 1πCenterText "EEEEEE    CCCC    PPPPP "πCenterText "EEEEEE   CCCCCC   PPPPPP"πCenterText "EE       CC  CC   PP  PP"πCenterText "EE       CC       PP  PP"πCenterText "EEEEE    CC       PPPPPP"πCenterText "EEEEE    CC       PPPPP "πCenterText "EE       CC       PP    "πCenterText "EE       CC  CC   PP    "πCenterText "EEEEEE   CCCCCC   PP    "πCenterText "EEEEEE    CCCC    PP    "πPRINTπPRINTπCenterText "Enigma Coding Program v1.0"πPRINTπCenterText "1995 Paul Kuliniewicz"πStatusLine "Welcome to the Enigma Coding Program!  Press any key to continue.", "WELCOME"πSLEEP: trash$ = INKEY$πGOTO MainMenuπ' *** Main Menu Routine ***πMainMenu:πIF firsttime% = FALSE THENπ  LOCATE 1, 1π  COLOR 4, 7π  PRINT "┌─────MAIN MENU─────┐"π  PRINT "│  1. Code a file   │"π  PRINT "│  2. Decode a file │"π  PRINT "│  3. Kill a file   │"π  PRINT "│  4. Shell to DOS  │"π  PRINT "│  5. Help          │"π  PRINT "│  6. Leave ECP     │"π  PRINT "└───────────────────┘"π  Shadow 2, 22, 9, 2, 9, 22π  SaveImage mainimage%()π  firsttime% = TRUEπELSEπ  LoadImage mainimage%()πEND IFπmin% = 2πmax% = 7πoldarrow% = 2πnewarrow% = 2πchoice% = 1πentered% = FALSEπDOπ  POKE ConvBlock%(oldarrow%, 3, 0), ASC(" ")π  POKE ConvBlock%(newarrow%, 3, 0), ASC("»")π  StatusLine mainstatus$(choice%), "MENU"π  pressed$ = Character$π  oldarrow% = newarrow%π  IF LEN(pressed$) = 2 AND RIGHT$(pressed$, 1) = CHR$(72) THENπ    IF choice% = 1 THENπ      newarrow% = max%π      choice% = 6π    ELSEπ      newarrow% = newarrow% - 1π      choice% = choice% - 1π    END IFπ  ELSEIF LEN(pressed$) = 2 AND RIGHT$(pressed$, 1) = CHR$(80) THENπ    IF choice% = 6 THENπ      newarrow% = min%π      choice% = 1π    ELSEπ      newarrow% = newarrow% + 1π      choice% = choice% + 1π    END IFπ  ELSEIF pressed$ = CHR$(13) THENπ    entered% = TRUEπ  END IFπLOOP UNTIL entered% = TRUEπON choice% GOTO Code, Decode, Delete, DOS, Help, Quitπ' *** Coding Routine ***πCode:πCOLOR 4, 7πLOCATE 3, 3: PRINT "┌──────────────────────────CODE──────────────────────────┐"πLOCATE 4, 3: PRINT "│ Enter the file (and path, if needed) you wish to code. │"πLOCATE 5, 3: PRINT "│ >                                                      │"πLOCATE 6, 3: PRINT "└────────────────────────────────────────────────────────┘"πShadow 4, 61, 7, 4, 7, 61πSaveImage screenimage%()πStatusLine "Type in the file name to code.", "CODE"πLOCATE 5, 6πLINE INPUT "", filename$πLOCATE 5, 5: PRINT "┌────────────CODE────────────┐"πLOCATE 6, 5: PRINT "│ Coding file.  Please wait. │"πLOCATE 7, 5: PRINT "└────────────────────────────┘"πShadow 6, 35, 8, 6, 8, 35πTinker:πStatusLine "Please wait.  Accessing Disk.", "CODE"πinfo$ = SPACE$(10000)πOPEN filename$ FOR BINARY AS #1πIF LOF(1) = 0 THENπ  CLOSE #1π  KILL filename$π  ERROR 53πEND IFπtrash$ = MessWithByte$("NEW")πlength& = LOF(1)πFOR counter& = 1 TO length& - (length& MOD 10000) STEP 10000π  GET #1, counter&, info$π  FOR count% = 1 TO LEN(info$)π    MID$(info$, count%, 1) = MessWithByte$(MID$(info$, count%, 1))π  NEXT count%π  PUT #1, counter&, info$πNEXT counter&πinfo$ = SPACE$(length& MOD 10000)πGET #1, (length& - (length& MOD 10000)) + 1, info$πFOR count% = 1 TO LEN(info$)π  MID$(info$, count%, 1) = MessWithByte$(MID$(info$, count%, 1))πNEXT count%πPUT #1, (length& - (length& MOD 10000)) + 1, info$πCLOSE #1πIF choice% = 2 THEN GOTO AllDoneπLoadImage screenimage%()πLOCATE 5, 5: PRINT "┌───────CODE───────┐"πLOCATE 6, 5: PRINT "│ Coding finished. │"πLOCATE 7, 5: PRINT "└──────────────────┘"πShadow 6, 25, 8, 6, 8, 25πStatusLine "Press any key to continue.", "CODE"πSLEEP: trash$ = INKEY$πGOTO MainMenuπ' *** Decoding Routine ***πDecode:πCOLOR 4, 7πLOCATE 3, 3: PRINT "┌──────────────────────────DECODE──────────────────────────┐"πLOCATE 4, 3: PRINT "│ Enter the file (and path, if needed) you wish to decode. │"πLOCATE 5, 3: PRINT "│ >                                                        │"πLOCATE 6, 3: PRINT "└──────────────────────────────────────────────────────────┘"πShadow 4, 63, 7, 4, 7, 63πSaveImage screenimage%()πStatusLine "Type in the file name to decode.", "DECODE"πLOCATE 5, 6πLINE INPUT "", filename$πLOCATE 5, 5: PRINT "┌────────────DECODE────────────┐"πLOCATE 6, 5: PRINT "│ Decoding file.  Please wait. │"πLOCATE 7, 5: PRINT "└──────────────────────────────┘"πShadow 6, 37, 8, 6, 8, 37πStatusLine "Please wait.  Accessing disk.", "DECODE"πGOTO Tinkerπinfo$ = SPACE$(10000)πOPEN filename$ FOR BINARY AS #1πIF LOF(1) = 0 THENπ  CLOSE #1π  KILL filename$π  ERROR 53πEND IFπtrash$ = MessWithByte$("NEW")πlength& = LOF(1)πFOR counter& = 1 TO length% - (length& MOD 10000) STEP 10000π  GET #1, counter&, info$π  FOR count% = 1 TO LEN(info$)π    MID$(info$, count%, 1) = MessWithByte$(MID$(info$, count%, 1))π  NEXT count%π  PUT #1, counter&, info$πNEXT counter&πinfo$ = SPACE$(length& MOD 10000)πGET #1, (length& - (length& MOD 10000)) + 1, info$πFOR count% = 1 TO LEN(info$)π  MID$(info$, count%, 1) = MessWithByte$(MID$(info$, count%, 1))πNEXT count%πPUT #1, (length& - (length& MOD 10000)) + 1, info$πCLOSE #1πAllDone:πLoadImage screenimage%()πLOCATE 5, 5: PRINT "┌───────DECODE───────┐"πLOCATE 6, 5: PRINT "│ Decoding finished. │"πLOCATE 7, 5: PRINT "└────────────────────┘"πShadow 6, 27, 8, 6, 8, 27πStatusLine "Press any key to continue.", "DECODE"πSLEEP: trash$ = INKEY$πGOTO MainMenuπ' *** Killing Routine ***πDelete:πCOLOR 4, 7πLOCATE 3, 3: PRINT "┌──────────────────────────KILL──────────────────────────┐"πLOCATE 4, 3: PRINT "│ Enter the file (and path, if needed) you wish to kill. │"πLOCATE 5, 3: PRINT "│ >                                                      │"πLOCATE 6, 3: PRINT "└────────────────────────────────────────────────────────┘"πShadow 4, 61, 7, 4, 7, 61πSaveImage screenimage%()πStatusLine "Type in the file to kill.", "KILL"πLOCATE 5, 6πLINE INPUT "", filename$πLOCATE 5, 5: PRINT "┌──────────────────────────DANGER───────────────────────────┐"πLOCATE 6, 5: PRINT "│ KILLING A FILE WILL TOTALLY DESTROY IT BEYOND ALL HOPE OF │"πLOCATE 7, 5: PRINT "│ REPAIR!  NOT EVEN AN UNDELETE PROGRAM CAN SAVE IT!  ARE   │"πLOCATE 8, 5: PRINT "│ YOU SURE YOU WANT TO DO THIS?  (Y/N)                      │"πLOCATE 9, 5: PRINT "└───────────────────────────────────────────────────────────┘"πShadow 6, 66, 10, 6, 10, 66πStatusLine "Press Y for YES or N for NO.", "KILL"πDOπ  rusure$ = UCASE$(Character$)πLOOP UNTIL rusure$ = "Y" OR rusure$ = "N"πIF rusure$ = "N" THEN GOTO MainMenuπLoadImage screenimage%()πLOCATE 5, 5: PRINT "┌──────────────────────WARNING──────────────────────┐"πLOCATE 6, 5: PRINT "│ THERE IS NO WAY TO RECOVER THIS FILE IF YOU KILL  │"πLOCATE 7, 5: PRINT "│ IT.  ARE YOU ABSOLUTELY SURE YOU WANT TO DO THIS? │"πLOCATE 8, 5: PRINT "└───────────────────────────────────────────────────┘"πShadow 6, 58, 9, 6, 9, 58πStatusLine "Press Y for YES or N for NO.", "KILL"πDOπ  rusure$ = UCASE$(Character$)πLOOP UNTIL rusure$ = "Y" OR rusure$ = "N"πIF rusure$ = "N" THEN GOTO MainMenuπLoadImage screenimage%()πLOCATE 5, 5: PRINT "┌────────────KILL─────────────┐"πLOCATE 6, 5: PRINT "│ Killing file.  Please wait. │"πLOCATE 7, 5: PRINT "└─────────────────────────────┘"πShadow 6, 36, 8, 6, 8, 36πStatusLine "Please wait.  Accessing disk.", "KILL"πinfo$ = STRING$(10000, 0)πOPEN filename$ FOR BINARY AS #1πIF LOF(1) = 0 THENπ  CLOSE #1π  KILL filename$π  ERROR 53πEND IFπlength& = LOF(1)πFOR counter& = 1 TO length& - (length% MOD 10000) STEP 10000π  PUT #1, counter&, info$πNEXT counter&πinfo$ = SPACE$(length& MOD 10000)πPUT #1, (length& - (length& MOD 10000)) + 1, info$πCLOSE #1πKILL filename$πLoadImage screenimage%()πLOCATE 5, 5: PRINT "┌───────KILL────────┐"πLOCATE 6, 5: PRINT "│ Killing finished. │"πLOCATE 7, 5: PRINT "└───────────────────┘"πShadow 6, 26, 8, 6, 8, 26πStatusLine "Press any key to continue.", "KILL"πSLEEP: trash$ = INKEY$πGOTO MainMenuπ' *** DOS Shell Routine ***πDOS:πCOLOR 4, 7πLOCATE 3, 3: PRINT "┌─────────────────SHELL────────────────┐"πLOCATE 4, 3: PRINT "│ Initiating DOS Shell.  Type EXIT to  │"πLOCATE 5, 3: PRINT "│ return to the Enigma Coding Program. │"πLOCATE 6, 3: PRINT "└──────────────────────────────────────┘"πShadow 4, 43, 7, 4, 7, 43πStatusLine "Press any key to shell to DOS.", "SHELL"πSLEEP: trash$ = INKEY$πCOLOR 7, 0πCLSπSHELLπCOLOR 4, 7πGOTO MainMenuπ' *** Help Routine ***πHelp:πLoadImage mainimage%()πCOLOR 4, 7πLOCATE 3, 3: PRINT "┌─────HELP MENU─────┐"πLOCATE 4, 3: PRINT "│  1. Overview      │"πLOCATE 5, 3: PRINT "│  2. Coding files  │"πLOCATE 6, 3: PRINT "│  3. Killing files │"πLOCATE 7, 3: PRINT "│  4. Shell to DOS  │"πLOCATE 8, 3: PRINT "│  5. Disclaimer    │"πLOCATE 9, 3: PRINT "│  6. Exit Help     │"πLOCATE 10, 3: PRINT "└───────────────────┘"πShadow 4, 24, 11, 4, 11, 24πmin% = 4πmax% = 9πoldarrow% = 4πnewarrow% = 4πhelped% = 1πentered% = FALSEπDOπ  POKE ConvBlock%(oldarrow%, 5, 0), ASC(" ")π  POKE ConvBlock%(newarrow%, 5, 0), ASC("»")π  StatusLine helpstatus$(helped%), "HELP"π  pressed$ = Character$π  oldarrow% = newarrow%π  IF LEN(pressed$) = 2 AND RIGHT$(pressed$, 1) = CHR$(72) THENπ    IF helped% = 1 THENπ      newarrow% = max%π      helped% = 6π    ELSEπ      newarrow% = newarrow% - 1π      helped% = helped% - 1π    END IFπ  ELSEIF LEN(pressed$) = 2 AND RIGHT$(pressed$, 1) = CHR$(80) THENπ    IF helped% = 6 THENπ      newarrow% = min%π      helped% = 1π    ELSEπ      newarrow% = newarrow% + 1π      helped% = helped% + 1π    END IFπ  ELSEIF pressed$ = CHR$(13) THENπ    entered% = TRUEπ  END IFπLOOP UNTIL entered% = TRUEπSELECT CASE helped%πCASE 1π  LOCATE 5, 5: PRINT "┌─────────────────────────OVERVIEW─────────────────────────┐"π  LOCATE 6, 5: PRINT "│ The Enigma Coding Program is a useful file safety device │"π  LOCATE 7, 5: PRINT "│ for coding, decoding, and killing files.  This program   │"π  LOCATE 8, 5: PRINT "│ can code files in a way that only it can decode.  Also,  │"π  LOCATE 9, 5: PRINT "│ to completely destroy files, you can kill them.  All     │"π  LOCATE 10, 5: PRINT "│ this comes with an easy-to-use, window-based interface.  │"π  LOCATE 11, 5: PRINT "│ The other options in the Help Menu will give you details │"π  LOCATE 12, 5: PRINT "│ about these particular operations.  Please read the dis- │"π  LOCATE 13, 5: PRINT "│ claimer before using this program.                       │"π  LOCATE 14, 5: PRINT "└──────────────────────────────────────────────────────────┘"π  Shadow 6, 65, 15, 6, 15, 65πCASE 2π  LOCATE 5, 5: PRINT "┌──────────────────────────CODING──────────────────────────┐"π  LOCATE 6, 5: PRINT "│ The Enigma Coding Program can code files so other people │"π  LOCATE 7, 5: PRINT "│ can't use them.  This process works with any file, whe-  │"π  LOCATE 8, 5: PRINT "│ ther it's an *.EXE, *.BAT, *.WMF, *.INI, etc.  To code a │"π  LOCATE 9, 5: PRINT "│ file, choose Code a File from the Main Menu and follow   │"π  LOCATE 10, 5: PRINT "│ the simple instructions.  To decode a file, choose De-   │"π  LOCATE 11, 5: PRINT "│ code a File from the Main Menu and follow the similar    │"π  LOCATE 12, 5: PRINT "│ instructions.                                            │"π  LOCATE 13, 5: PRINT "└──────────────────────────────────────────────────────────┘"π  Shadow 6, 65, 14, 6, 14, 65πCASE 3π  LOCATE 5, 5: PRINT "┌─────────────────────────KILLING──────────────────────────┐"π  LOCATE 6, 5: PRINT "│ The Enigma Coding Program can wipe out files.  This is   │"π  LOCATE 7, 5: PRINT "│ not the same as erasing!  When you kill a file, all the  │"π  LOCATE 8, 5: PRINT "│ bytes in the file are assigned the null (0) value before │"π  LOCATE 9, 5: PRINT "│ being deleted.  Even an undelete program will only bring │"π  LOCATE 10, 5: PRINT "│ back a bunch of null characters.  To kill a file, choose │"π  LOCATE 11, 5: PRINT "│ Kill a File from the Main Menu and follow the simple     │"π  LOCATE 12, 5: PRINT "│ instructions.                                            │"π  LOCATE 13, 5: PRINT "└──────────────────────────────────────────────────────────┘"π  Shadow 6, 65, 14, 6, 14, 65πCASE 4π  LOCATE 5, 5: PRINT "┌─────────────────────────SHELLING─────────────────────────┐"π  LOCATE 6, 5: PRINT "│ The Enigma Coding Program allows you to temporarily use  │"π  LOCATE 7, 5: PRINT "│ DOS while the program is running.  While in the shell,   │"π  LOCATE 8, 5: PRINT "│ you can execute any commands you normally can.  When you │"π  LOCATE 9, 5: PRINT "│ are finished, type EXIT to end the shell.  To execute    │"π  LOCATE 10, 5: PRINT "│ the shell, choose Shell to DOS from the Main Menu.       │"π  LOCATE 11, 5: PRINT "└──────────────────────────────────────────────────────────┘"π  Shadow 6, 65, 12, 6, 12, 65πCASE 5π  LOCATE 5, 5: PRINT "┌────────────────────────DISCLAIMER────────────────────────┐"π  LOCATE 6, 5: PRINT "│ DO NOT TAMPER WITH OR EDIT THIS FILE IN ANY WAY!  DOING  │"π  LOCATE 7, 5: PRINT "│ SO MAY CAUSE THIS PROGRAM TO MALFUNCTION AND DAMAGE ANY  │"π  LOCATE 8, 5: PRINT "│ AND ALL FILES YOU WORK WITH!  THE AUTHOR IS NOT RESPON-  │"π  LOCATE 9, 5: PRINT "│ SIBLE FOR ANY DAMAGE DUE TO ANY EDITING!  YOU ARE FREE   │"π  LOCATE 10, 5: PRINT "│ TO COPY AND DISTRIBUTE THIS PROGRAM TO ANYONE YOU WISH,  │"π  LOCATE 11, 5: PRINT "│ AS LONG AS THE FILE IS UNALTERED IN ANY CONCEIVABLE WAY! │"π  LOCATE 12, 5: PRINT "└──────────────────────────────────────────────────────────┘"π  Shadow 6, 65, 13, 6, 13, 65πEND SELECTπIF helped% = 6 THEN GOTO MainMenuπStatusLine "Press any key to return to the Help Menu.", "HELP"πSLEEP: trash$ = INKEY$πGOTO Helpπ' *** Exit Program Routine ***πQuit:πCOLOR 4, 7πLOCATE 3, 3: PRINT "┌───────BYE────────┐"πLOCATE 4, 3: PRINT "│ Have a nice day! │"πLOCATE 5, 3: PRINT "└──────────────────┘"πShadow 4, 23, 6, 4, 6, 23πStatusLine "Press any key to exit ECP.", "BYE"πSLEEP: trash$ = INKEY$πSYSTEMπ' *** Error Handler Routine ***πHandleError:πCOLOR 4, 7πRESETπSELECT CASE ERRπCASE 52π  RESUME MainMenuπCASE 53π  LOCATE 7, 7: PRINT "┌────────────────ERROR────────────────┐"π  LOCATE 8, 7: PRINT "│ That file could not be found on the │"π  LOCATE 9, 7: PRINT "│ indicated drive and directory.      │"π  LOCATE 10, 7: PRINT "└─────────────────────────────────────┘"π  Shadow 8, 46, 11, 8, 11, 46πCASE 61π  LOCATE 7, 7: PRINT "┌─────────────────────ERROR─────────────────────┐"π  LOCATE 8, 7: PRINT "│ There is not enough free space on that drive. │"π  LOCATE 9, 7: PRINT "└───────────────────────────────────────────────┘"π  Shadow 8, 56, 10, 8, 10, 56πCASE 64π  LOCATE 7, 7: PRINT "┌──────────────────────ERROR──────────────────────┐"π  LOCATE 8, 7: PRINT "│ That file name contains invalid DOS characters. │"π  LOCATE 9, 7: PRINT "└─────────────────────────────────────────────────┘"π  Shadow 8, 58, 10, 8, 10, 58πCASE 70π  LOCATE 7, 7: PRINT "┌─────────────ERROR─────────────┐"π  LOCATE 8, 7: PRINT "│ That disk is write-protected. │"π  LOCATE 9, 7: PRINT "└───────────────────────────────┘"π  Shadow 8, 40, 10, 8, 10, 40πCASE 71π  LOCATE 7, 7: PRINT "┌────────────────────────ERROR────────────────────────┐"π  LOCATE 8, 7: PRINT "│ That disk drive is open or there is no disk inside. │"π  LOCATE 9, 7: PRINT "└─────────────────────────────────────────────────────┘"π  Shadow 8, 62, 10, 8, 10, 62πCASE 72π  LOCATE 7, 7: PRINT "┌───────────────────ERROR───────────────────┐"π  LOCATE 8, 7: PRINT "│ That disk's surface is physically flawed. │"π  LOCATE 9, 7: PRINT "└───────────────────────────────────────────┘"π  Shadow 8, 52, 10, 8, 10, 52πCASE 75π  LOCATE 7, 7: PRINT "┌──────────────────ERROR──────────────────┐"π  LOCATE 8, 7: PRINT "│ You can't code, decode, or kill a path. │"π  LOCATE 9, 7: PRINT "└─────────────────────────────────────────┘"π  Shadow 8, 50, 10, 8, 10, 50πCASE 76π  LOCATE 7, 7: PRINT "┌──────────────────ERROR──────────────────┐"π  LOCATE 8, 7: PRINT "│ That path can't be found on this drive. │"π  LOCATE 9, 7: PRINT "└─────────────────────────────────────────┘"π  Shadow 8, 50, 10, 8, 10, 50πCASE ELSEπ  LOCATE 7, 7: PRINT "┌────────────────────────ERROR─────────────────────────┐"π  LOCATE 8, 7: PRINT "│ Unidentified error";π  PRINT USING " ### "; ERR;π  PRINT "reported!  Please contact the │"π  LOCATE 9, 7: PRINT "│ author via e-mail at [e-mail].  Unfortunatly, │"π  LOCATE 10, 7: PRINT "│ ECP cannot recover.                                  │"π  LOCATE 11, 7: PRINT "└──────────────────────────────────────────────────────┘"π  Shadow 8, 63, 12, 8, 12, 63π  StatusLine "Press any key to abort ECP.", "ERROR"π  SLEEP: trash$ = INKEY$π  SYSTEMπEND SELECTπStatusLine "Press any key to return.", "ERROR"πSLEEP: trash$ = INKEY$πIF choice% >= 1 AND choice% <= 3 THEN LoadImage screenimage%()πSELECT CASE choice%πCASE 1π  RESUME CodeπCASE 2π  RESUME DecodeπCASE 3π  RESUME DeleteπCASE ELSEπ  RESUME MainMenuπEND SELECTπ' *** Data for Main Menu Status Line ***πDATA "Code a file with the ECP technique."πDATA "Decode a file coded with the ECP technique."πDATA "Totally destroy a file."πDATA "Use DOS without exiting ECP."πDATA "Additional help with ECP."πDATA "Returns you to your operating system."π' *** Data for Help Menu Status Line ***πDATA "Read the overview of ECP."πDATA "Read about coding and decoding files."πDATA "Read about killing files."πDATA "Read about the DOS Shell."πDATA "Read very important warnings."πDATA "Return to the Main Menu."π' *** End of file "ECP.BAS" ***ππSUB CenterText (text$)π  blanks% = INT((80 - LEN(text$)) / 2)π  PRINT TAB(blanks%); text$πEND SUBππFUNCTION Character$π  DOπ    justpushed$ = INKEY$π  LOOP UNTIL justpushed$ <> CHR$(0)π  Character$ = justpushed$πEND FUNCTIONππFUNCTION ConvBlock% (row%, column%, colormem%)π  ConvBlock% = (((column% * 2) - 2) + ((row% * 160) - 160)) + colormem%πEND FUNCTIONππFUNCTION ConvColor% (fore%, back%)π  ConvColor% = fore% + (back% * 16)πEND FUNCTIONππSUB LoadImage (showme%())π  FOR counter% = 0 TO 4001π    POKE counter%, showme%(counter%)π  NEXT counter%πEND SUBππFUNCTION MakeBinary$ (convert%)π  equiv$ = HEX$(convert%)π  IF convert% <= 15 THEN equiv$ = "0" + equiv$π  FOR counter% = 1 TO LEN(equiv$)π    onepart$ = MID$(equiv$, counter%, 1)π    IF onepart$ = "0" THENπ      result$ = result$ + "0000"π    ELSEIF onepart$ = "1" THENπ      result$ = result$ + "0001"π    ELSEIF onepart$ = "2" THENπ      result$ = result$ + "0010"π    ELSEIF onepart$ = "3" THENπ      result$ = result$ + "0011"π    ELSEIF onepart$ = "4" THENπ      result$ = result$ + "0100"π    ELSEIF onepart$ = "5" THENπ      result$ = result$ + "0101"π    ELSEIF onepart$ = "6" THENπ      result$ = result$ + "0110"π    ELSEIF onepart$ = "7" THENπ      result$ = result$ + "0111"π    ELSEIF onepart$ = "8" THENπ      result$ = result$ + "1000"π    ELSEIF onepart$ = "9" THENπ      result$ = result$ + "1001"π    ELSEIF onepart$ = "A" THENπ      result$ = result$ + "1010"π    ELSEIF onepart$ = "B" THENπ      result$ = result$ + "1011"π    ELSEIF onepart$ = "C" THENπ      result$ = result$ + "1100"π    ELSEIF onepart$ = "D" THENπ      result$ = result$ + "1101"π    ELSEIF onepart$ = "E" THENπ      result$ = result$ + "1110"π    ELSEIF onepart$ = "F" THENπ      result$ = result$ + "1111"π    END IFπ  NEXT counter%π  MakeBinary$ = result$πEND FUNCTIONππFUNCTION MakeDecimal% (byte$)π  result% = 0π  IF LEFT$(byte$, 1) = "1" THEN result% = result% + 128π  IF MID$(byte$, 2, 1) = "1" THEN result% = result% + 64π  IF MID$(byte$, 3, 1) = "1" THEN result% = result% + 32π  IF MID$(byte$, 4, 1) = "1" THEN result% = result% + 16π  IF MID$(byte$, 5, 1) = "1" THEN result% = result% + 8π  IF MID$(byte$, 6, 1) = "1" THEN result% = result% + 4π  IF MID$(byte$, 7, 1) = "1" THEN result% = result% + 2π  IF RIGHT$(byte$, 1) = "1" THEN result% = result% + 1π  MakeDecimal% = result%πEND FUNCTIONππFUNCTION MessWithByte$ (original$)π  STATIC style%π  IF original$ = "NEW" THENπ    style% = 0π    EXIT FUNCTIONπ  END IFπ  style% = style% + 1π  IF style% > 20 THEN style% = 1π  decimal% = ASC(original$)π  base2$ = MakeBinary$(decimal%)π  bit1$ = LEFT$(base2$, 1)π  bit2$ = MID$(base2$, 2, 1)π  bit3$ = MID$(base2$, 3, 1)π  bit4$ = MID$(base2$, 4, 1)π  bit5$ = MID$(base2$, 5, 1)π  bit6$ = MID$(base2$, 6, 1)π  bit7$ = MID$(base2$, 7, 1)π  bit8$ = RIGHT$(base2$, 1)π  SELECT CASE style%π      CASE 1π        bit1$ = PseudoNOT$(bit1$)π        bit4$ = PseudoNOT$(bit4$)π        bit6$ = PseudoNOT$(bit6$)π        bit7$ = PseudoNOT$(bit7$)π      CASE 2π        bit2$ = PseudoNOT$(bit2$)π        bit3$ = PseudoNOT$(bit3$)π        bit5$ = PseudoNOT$(bit5$)π        bit8$ = PseudoNOT$(bit8$)π      CASE 3π        SWAP bit1$, bit2$π        SWAP bit3$, bit4$π        SWAP bit5$, bit6$π        SWAP bit7$, bit8$π      CASE 4π        SWAP bit1$, bit8$π        SWAP bit2$, bit7$π        SWAP bit4$, bit5$π      CASE 5π        bit1$ = PseudoNOT$(bit1$)π        bit2$ = PseudoNOT$(bit2$)π        bit3$ = PseudoNOT$(bit3$)π        bit4$ = PseudoNOT$(bit4$)π        SWAP bit5$, bit8$π        SWAP bit6$, bit7$π      CASE 6π      CASE 7π        bit1$ = PseudoNOT$(bit1$)π        SWAP bit2$, bit3$π        bit4$ = PseudoNOT$(bit4$)π        bit5$ = PseudoNOT$(bit5$)π        SWAP bit6$, bit7$π        bit8$ = PseudoNOT$(bit8$)π      CASE 8π        SWAP bit1$, bit3$π        SWAP bit2$, bit4$π      CASE 9π        bit1$ = PseudoNOT$(bit1$)π        bit2$ = PseudoNOT$(bit2$)π        bit3$ = PseudoNOT$(bit3$)π        bit4$ = PseudoNOT$(bit4$)π        bit5$ = PseudoNOT$(bit5$)π        bit6$ = PseudoNOT$(bit6$)π        bit7$ = PseudoNOT$(bit7$)π        bit8$ = PseudoNOT$(bit8$)π      CASE 10π        SWAP bit1$, bit5$π        SWAP bit2$, bit6$π        SWAP bit3$, bit7$π        SWAP bit4$, bit8$π      CASE 11π        bit1$ = PseudoNOT$(bit1$)π        SWAP bit2$, bit3$π        bit4$ = PseudoNOT$(bit4$)π        bit5$ = PseudoNOT$(bit5$)π        SWAP bit6$, bit8$π        bit7$ = PseudoNOT$(bit7$)π      CASE 12π        SWAP bit1$, bit3$π        SWAP bit2$, bit6$π        bit4$ = PseudoNOT$(bit4$)π        SWAP bit5$, bit8$π        bit7$ = PseudoNOT$(bit7$)π      CASE 13π        SWAP bit1$, bit6$π        bit2$ = PseudoNOT$(bit2$)π        SWAP bit3$, bit8$π        bit4$ = PseudoNOT$(bit4$)π        bit5$ = PseudoNOT$(bit5$)π        bit7$ = PseudoNOT$(bit7$)π      CASE 14π        SWAP bit2$, bit7$π        SWAP bit4$, bit5$π      CASE 15π        bit1$ = PseudoNOT$(bit1$)π        SWAP bit2$, bit4$π        bit3$ = PseudoNOT$(bit3$)π        bit7$ = PseudoNOT$(bit7$)π        bit8$ = PseudoNOT$(bit8$)π      CASE 16π        SWAP bit1$, bit6$π        SWAP bit2$, bit7$π        SWAP bit3$, bit8$π        SWAP bit4$, bit5$π      CASE 17π        bit1$ = PseudoNOT$(bit1$)π        SWAP bit2$, bit4$π        bit3$ = PseudoNOT$(bit3$)π        bit5$ = PseudoNOT$(bit5$)π        SWAP bit6$, bit8$π        bit7$ = PseudoNOT$(bit7$)π      CASE 18π        SWAP bit1$, bit2$π        bit3$ = PseudoNOT$(bit3$)π        SWAP bit4$, bit8$π        SWAP bit5$, bit7$π        bit6$ = PseudoNOT$(bit6$)π      CASE 19π        SWAP bit1$, bit5$π        bit2$ = PseudoNOT$(bit2$)π        bit3$ = PseudoNOT$(bit3$)π        SWAP bit4$, bit6$π        bit7$ = PseudoNOT$(bit7$)π        bit8$ = PseudoNOT$(bit8$)π      CASE 20π        SWAP bit1$, bit8$π        bit2$ = PseudoNOT$(bit2$)π        bit3$ = PseudoNOT$(bit3$)π        bit4$ = PseudoNOT$(bit4$)π        bit5$ = PseudoNOT$(bit5$)π        bit6$ = PseudoNOT$(bit6$)π        bit7$ = PseudoNOT$(bit7$)π      END SELECTπ  base2$ = bit1$ + bit2$ + bit3$ + bit4$ + bit5$ + bit6$ + bit7$ + bit8$π  decimal% = MakeDecimal%(base2$)π  MessWithByte$ = CHR$(decimal%)πEND FUNCTIONππFUNCTION PseudoNOT$ (bit$)π  IF bit$ = "1" THENπ    PseudoNOT$ = "0"π  ELSEπ    PseudoNOT$ = "1"π  END IFπEND FUNCTIONππSUB SaveImage (saveme%())π  FOR counter% = 0 TO 4001π    saveme%(counter%) = PEEK(counter%)π  NEXT counter%πEND SUBππSUB Shadow (urr%, urc%, llr%, llc%, lrr%, lrc%)π  FOR counter% = ConvBlock%(urr%, urc%, 1) TO ConvBlock%(lrr%, lrc%, 1) STEP 160π    POKE counter%, ConvColor%(8, 0)π  NEXT counter%π  FOR counter% = ConvBlock%(llr%, llc%, 1) TO ConvBlock%(lrr%, lrc%, 1) STEP 2π    POKE counter%, ConvColor%(8, 0)π  NEXT counter%πEND SUBππSUB StatusLine (message$, sector$)π  display$ = SPACE$(72)π  area$ = SPACE$(7)π  LSET display$ = message$π  RSET area$ = sector$π  total$ = display$ + "│" + area$π  FOR counter% = 1 TO 80π    POKE ConvBlock%(25, counter%, 1), ConvColor%(7, 4)π  NEXT counter%π  FOR counter% = 1 TO 80π    POKE ConvBlock%(25, counter%, 0), ASC(MID$(total$, counter%, 1))π  NEXT counter%πEND SUBπJonathan Leger                 XOR ENCRYPTION/DECRYPTION      [e-mail]             08-10-96 (12:55)       QB, QBasic, PDS        168  6372     XOR.BAS     '(*** XOR.BAS ***)π'(*************************************************************************)π'(*** This is a small demonstration of the XOR encryption/decryption    ***)π'(*** method that will encrypt this file (assuming the name is XOR.BAS) ***)π'(*** and put it in the file XOR.XOR.  If you want it to decrypt the    ***)π'(*** XOR.XOR file once it's been encrypted, merely change the FILE$    ***)π'(*** to XOR.XOR and the OUTPUT$ to XOR.BAS (or whatever).  The key     ***)π'(*** we will be using is 15.  You can change that for your purposes,   ***)π'(*** but the key must be a value from 0 to 255.                        ***)π'(*************************************************************************)π'(*** This method of encryption is not very secure, since it can be     ***)π'(*** broken easily by the brute force method (though it used to be a   ***)π'(*** very popular form of encryption).  However, for most purposes,    ***)π'(*** such as game high scores or passwords, etc, it serves quite well, ***)π'(*** since the person has no way to know that the file was encrypted   ***)π'(*** using this method, and most people wouldn't think to try and      ***)π'(*** decrypt it themselves anyway.                                     ***)π'(*************************************************************************)π'(*** The File.XOR function returns a FALSE value (0) if the input file ***)π'(*** (FILE$) does ***) not exist, otherwise it returns TRUE (-1).      ***)π'(*************************************************************************)ππDECLARE FUNCTION File.XOR% (FILE$, output$, ekey%, sbarx%, sbary%, sbarlen%)ππSCREEN 0πWIDTH 80, 25πCOLOR 7, 0πCLSππFILE$ = "xor.bas"       '(*** We'll encrypt this file... ***)πoutput$ = "xor.xor"     '(*** ...and put the results here. ***)πekey% = 15              '(*** Our encryption key will be 15. ***)ππLOCATE 1, 1πPRINT "Using XOR method of encryption/decription on " + UCASE$(FILE$) + "..."ππ'(*** Use a status bar for the encryption. ***)πCOLOR 15, 1πErrVal = File.XOR%(FILE$, output$, ekey%, 1, 2, 40)ππIF ErrVal THEN    '(*** No errors! ***)π   LOCATE 1, 1: COLOR 7, 0π   PRINT STRING$(80, " ");π   LOCATE 1, 1π   PRINT "Success!  Results in file (" + UCASE$(output$) + ")."πELSEπ   '(*** The file didn't exist! ***)π   LOCATE 1, 1: COLOR 7, 0π   PRINT STRING$(80, " ");π   LOCATE 1, 1π   PRINT "Input file ("; UCASE$(FILE$); ") does not exist."πEND IFππDEFINT A-Zπ'(*** File.XOR () ****)π'(*** ----------- ****)π'(*** Thie function will take a file (INPUT$) and XOR each byte with  ***)π'(*** the given encryption key (EKEY), puting the results into a file ***)π'(*** (OUTPUT$).  If you want a status bar showing progress, pass the ***)π'(*** x and y location of the status bar on-screen (SBARX, SBARY). If ***)π'(*** no status bar is desired, pass a 0 for the x and y.  SBARLEN is ***)π'(*** the length you want the status bar to be.                       ***)π'(*** NOTICE:  To unXOR the file, just pass the XORed file the the    ***)π'(*** function with the _SAME_ encryption key.  Given the nature of   ***)π'(*** XOR, an individual decryption scheme is not needed.  Note, too, ***)π'(*** that EKEY can only be from 0 to 255.                            ***)π'(*** --------------------------------------------------------------- ***)πFUNCTION File.XOR (FILE$, output$, ekey, sbarx, sbary, sbarlen)ππ'(*** Check if the input file passed exist. ***)π'(*** If the input file doesn't exist, exit with error  ***)π'(*** value 0 [FALSE].                                  ***)πfilenum = FREEFILEπOPEN FILE$ FOR BINARY AS filenumππIF LOF(filenum) = 0 THENπ   '(*** Pass error value back since file didn't exist. ***)π   File.XOR = 0π   CLOSE filenumπ   '(*** Kill the 0 byte file we made by opening it. ***)π   KILL FILE$π   EXIT FUNCTIONπEND IFππ'(*** Both files exist, open them. ***)πCLOSE filenumπOPEN FILE$ FOR INPUT AS filenumπoutputnum = FREEFILEπOPEN output$ FOR OUTPUT AS outputnumππ'(*** If we want a status bar, do the encryption with a status bar! ***)πIF sbarx > 0 THENπ   '(*** Draw empty status bar and reset the byte count# to 0. ***)π   LOCATE sbary, sbarx: PRINT STRING$(sbarlen, 177);π   count# = 0π   '(*** Encrypt/Decrypt the file. ***)π   DO WHILE NOT EOF(1)π   π      '(*** Read a byte from the file. ***)π      bytes.left# = LOF(filenum) - LOF(outputnum)π      IF bytes.left# < 100 THENπ         read.bytes$ = INPUT$(bytes.left#, filenum)π         chunk = bytes.left#π      ELSEπ         read.bytes$ = INPUT$(100, filenum)π         chunk = 100π      END IFπ     π      '(*** Increment byte count#. ***)π      count# = count# + chunkππ      '(*** XOR the bytes with encryption key. ***)π      FOR byte.count = 1 TO chunkπ         changed.byte$ = changed.byte$ + CHR$(ASC(MID$(read.bytes$, byte.count, 1)) XOR ekey)π      NEXT byte.countπ     π      '(*** Print it to the output file. ***)π      PRINT #outputnum, changed.byte$;π      changed.byte$ = ""ππ      '(*** If a chunk of 100 bytes has been read, update status bar. ***)π      IF count# MOD 1000 = 0 THENπ         LOCATE sbary, sbarxπ         PRINT STRING$(sbarlen * (count# / LOF(1)), 219);π      END IFππ   LOOPπ     π      LOCATE sbary, sbarxπ      PRINT STRING$(sbarlen, 219);ππELSEπ'(*** We didn't want a status bar, so skip the status bar.  This will ***)π'(*** give some extra speed because the print code is ignored.        ***)π  π   DO WHILE NOT EOF(1)π     π      '(*** Read a byte from the file. ***)π      bytes.left# = LOF(filenum) - LOF(outputnum)π      IF bytes.left# < 100 THENπ         read.bytes$ = INPUT$(bytes.left#, filenum)π         chunk = bytes.left#π      ELSEπ         read.bytes$ = INPUT$(100, filenum)π         chunk = 100π      END IFπ    π      '(*** XOR the bytes with encryption key. ***)π      FOR byte.count = 1 TO chunkπ         changed.byte$ = changed.byte$ + CHR$(ASC(MID$(read.bytes$, byte.count, 1)) XOR ekey)π      NEXT byte.countπ    π      '(*** Print it to the output file. ***)π      PRINT #outputnum, changed.byte$;π      changed.byte$ = ""ππ   LOOPππEND IFππ'(*** Close the files we used. ***)πCLOSE filenum, outputnumππ'(*** All done with no errors, so return a TRUE value. ***)πFile.XOR = -1ππEND FUNCTIONππKurt Kuzba                     8-BIT TO 6-BIT ENCODER/DECODER FidoNet QUIK_BAS Echo          06-01-96 (00:00)       QB, QBasic, PDS        44   1821     826_BIT.BAS '>   But my question is: Can we talk about and share code forπ'>   en/decoders? Since this topic is on my mind anyway, hasπ'>   anyone programmed a MIME-en/decoder and/or a UUEn/Decoder?π'>........................................π'   One of the simplest forms of encoding to text is to convertπ'from an 8-bit value to 6-bit. This allows you to have threeπ'normal ASCII characters coverted to four characters  within theπ'range of the lower, message format usable, ASCII. Try this:π'_|_|_|  826_BIT.BASπ'_|_|_|  This program demonstrates one method of encoding dataπ'_|_|_|  to conform to low ASCII requirements by turning threeπ'_|_|_|  8-bit values into four 6-bit values and vice-verse.π'_|_|_|  No warrantees or guarantees are given or implied.π'_|_|_|  Released to   PUBLIC DOMAIN   by Kurt Kuzba.  (6/1/96)πDECLARE FUNCTION ENCODE$ (Bytes3$)πDECLARE FUNCTION UNCODE$ (Bytes4$)πPRINT : PRINTπtest$ = CHR$(176) + CHR$(177) + CHR$(178)πPRINT test$, ENCODE$(test$), UNCODE$(ENCODE$(test$))πtest$ = CHR$(254) + CHR$(219) + CHR$(129)πPRINT test$, ENCODE$(test$), UNCODE$(ENCODE$(test$))πtest$ = CHR$(17) + CHR$(21) + CHR$(7)πPRINT test$, ENCODE$(test$), UNCODE$(ENCODE$(test$))πtest$ = "ABC"πPRINT test$, ENCODE$(test$), UNCODE$(ENCODE$(test$))πFUNCTION ENCODE$ (Bytes3$)π   Result$ = "": B& = 0π   FOR t% = 3 TO 1 STEP -1π      B& = B& * 256 + ASC(MID$(Bytes3$, t%))π   NEXTπ   FOR t% = 1 TO 4π      Result$ = Result$ + CHR$(48 + (B& AND 63)): B& = B& \ 64π   NEXT: ENCODE$ = Result$πEND FUNCTIONπFUNCTION UNCODE$ (Bytes4$)π   Result$ = "": B& = 0π   FOR t% = 4 TO 1 STEP -1π      B& = B& * 64 + ASC(MID$(Bytes4$, t%)) - 48π   NEXTπ   FOR t% = 1 TO 3π      Result$ = Result$ + CHR$(B& AND 255): B& = B& \ 256π   NEXT: UNCODE$ = Result$πEND FUNCTIONπ'_|_|_|   end   826_BIT.BASπEdward Di Geronimo Jr.         CHANGE FREQ OF SYSTEM TIMER    FidoNet QUIK_BAS Echo          07-07-96 (00:00)       QB, QBasic, PDS        68   2347     INTCLOCK.BAS'Here's some almost working code to get more precise timing inπ'QuickBasic. It works by changing the internal timer to generate anπ'interrupt more often than 18.2 times per second. To use this code, callπ'the ChangeTimer function, and to get the desired frequency use thisπ'formula:ππ'    1.19318mhzπ'-----------------π'desired freuqencyππ'18.2 comes about by dividing by 65535 (highest 16bit number).ππ'If you look at the code, you'll notice there are COUNTER0, 1, and 2π'constants. Counter 0 is the frequency of the system timer (which weπ'change), counter 1 is the ram refresh rate (don't change!), and counterπ'2 is related to the pc speaker (I doubt you should touch it).ππ'I know this works in C, but I don't know how well it will work in QB.π'It should effect the TIMER value. It would be great for games if weπ'could write our own ISR's to accompany this, but QB doesn't haveπ'pointers, let alone sub/function pointers, so we can't. Oh well. But ONπ'TIMER should be effected by this, so I guess we don't need one. I'llπ'leave it to you guys to figure it out.ππ'Code to change the frequency of the 8253 clock chip's interruptπ'generation. Public domain (C) by Edward Di Geronimo Jr. 7/7/96ππDEFINT A-ZππDECLARE SUB ChangeTimer (NewCount%)ππCONST CONTROL8253 = &H43  ' the 8253's control registerπCONST CONTROLWORD = &H3C  ' the control word to set mode 2π                          '    binary least/mostπCONST COUNTER0 = &H40     ' counter 0πCONST COUNTER1 = &H41     ' counter 1πCONST COUNTER2 = &H42     ' counter 2ππCONST TIMER60HZ = &H4DAE   ' 60 hzπCONST TIMER50HZ = &H5D37   ' 50 hzπCONST TIMER40HZ = &H7486   ' 40 hzπCONST TIMER30HZ = &H965C   ' 30 hzπCONST TIMER20HZ = &HE90B   ' 20 hzπCONST TIMER18HZ = &HFFFF   ' 18.2 hz (the standard count and the slowest possible)πChangeTimer TIMER60HZππDO WHILE INKEY$ = ""π    A# = TIMERπ    PRINT A#,π    WHILE A# = TIMER: WENDπLOOPππChangeTimer TIMER18HZππSUB ChangeTimer (NewCount)π' send the control word, mode 2, binary, least/most load sequenceππOUT CONTROL8253, CONTROLWORDππ' now write the least significant byte to the counter registerππOUT COUNTER0, NewCount AND &HFF            ' LOWBYTE(newcount)ππ' and now the the most significant byteππOUT COUNTER0, (NewCount AND &HFF00) / 256  ' HIGHBYTE(newcount)ππEND SUBπKevin J. Krumwiede             LINEAR DATE                    FidoNet QUIK_BAS Echo          07-12-96 (01:22)       QB, QBasic, PDS        64   1834     LIN_DATE.BAS' Hello everybody!  This program reports the current linear date, π' expressed as the number of seconds since 00:00 on 01-01-1970. π' This could be used the same way you might use TIMER to create π' delays, but without the complications of midnight rollover. π' This seems to be pretty fast, though I'm sure there's room for π' optimization.  I think I corected properly for all the special  π' cases (leap years, etc.), but if you spot any errors, please π' let me know!  Here it is: π π' ********************************************************************* π' lin_date.bas π' Written and released to the PUBLIC DOMAIN by Kevin J Krumwiede π' Calculates the linear date from 01-01-1970 as per the Unix convention π' ********************************************************************* π πDECLARE FUNCTION linearDate& () πDECLARE FUNCTION leapDays% (year%) π πCLS πPRINT "Current Linear Date:"; πPRINT linearDate& π πEND π πFUNCTION leapDays% (year%) π πIF (year% MOD 100 = 0) AND (year% MOD 4 <> 0) THEN π        leapDays% = 0 πELSEIF (year% MOD 4 = 0) THEN π        leapDays% = 1 πELSE π        leapDays% = 0 πEND IF π πEND FUNCTION π πFUNCTION linearDate& π πdt$ = DATE$ πm% = VAL(LEFT$(dt$, 2)) πd% = VAL(MID$(dt$, 4, 2)) πy% = VAL(RIGHT$(dt$, 4)) π πDIM days(1 TO 12) AS INTEGER πdays(1) = 31: days(2) = 28: days(3) = 31: days(4) = 30 πdays(5) = 31: days(6) = 30: days(7) = 31: days(8) = 31 πdays(9) = 30: days(10) = 31: days(11) = 30: days(12) = 31 π πlin& = 0 πFOR i% = 1970 TO y% - 1 π        lin& = lin& + 86400 * (365 + leapDays(y%)) πNEXT i% π πFOR i% = 1 TO m% - 1 π        lin& = lin& + 86400 * days(m%) πNEXT πIF m% > 2 THEN lin& = lin& + 86400 * leapDays(y%) π πlin& = lin& + 86400 * (d% - 1) πlin& = lin& + TIMER π πlinearDate& = lin& π πEND FUNCTION πEgbert Zijlema                 CONTINUALLY DISPLAY ACTUAL [e-mail]        07-21-96 (22:02)       PB                     225  7164     SHOWTIME.BAS' SHOWTIME.BAS ---- continuatedly displays the actual timeπ' Author          : Egbert Zijlema ([e-mail])π' Date            : July 21, 1996π' Language        : Power Basic 3.2π' Copyright status: Public Domainππ' Info:π' Most of the time a program is just waiting for user activityπ' (e.g. keyboard input). These "pauses" are the most excellentπ' moments to display the actual time. For instance at the menu bar.π' There is only 1 restriction: the Basic commands LOCATE and/or PRINTπ' should ALWAYS serve the user, so your program must write (POKE) theπ' time information directly to video memory.ππ' In this demo a sample menu lets you toggle between different formats:π' hh:mm:ss (the default TIME$)π' hh:mm (including a blinking colon)π' 12/24 hrs system, adding AM or PM for 12 hrsππ' For computers with vga card there is an extra font to displayπ' the time in 'digital' form. These font (earlier released asπ' "LOADFONT.BAS") includes the characters 0 - 9, A, P and M. Theyπ' will temporaryly replace the characters 224 throug 238 of theπ' default ASCII set. It is to be restored while quitting.π' ---------------------------------------------------------------------ππDEFINT A - Zππ%NO = 0 : %YES = NOT %NO           ' equates true/false (0/-1)ππ%AX = 1 : %BX = 2 : %CX = 3        ' equates for ...π%DX = 4 : %BP = 7 : %ES = 9        ' ... registersππTYPE CLOCKFLAGSπ  twelve AS INTEGER                ' 12 hrs clockπ  secs AS INTEGER                  ' show secondsπ  font AS INTEGER                  ' use special fontπEND TYPEππTYPE FLAGSπ  mono AS INTEGER                  ' monochrome screenπ  vga AS INTEGER                   ' ega/vga card presentπEND TYPEππDIM clok AS SHARED CLOCKFLAGSπDIM flg AS SHARED FLAGSπDIM VideoAddress AS SHARED INTEGERππIF (pbvScrnCard AND 1) = 0 THEN    ' test card typeπ  VideoAddress = &HB800            ' color cardπELSEπ  VideoAddress = &HB000            ' monochromeπ  flg.mono = %YESπEND IFππIF BIT(pbvScrnCard, 4) THEN        ' is it a vga-card as well?π  LoadFont                         ' load special charsπ  flg.vga = %YES                   ' vga modifications done!πEND IFππSUB LoadFontπ  cred$ = CHR$(126, 129, 189, 165, 161, 165, 189, 129, 126)π  phon$ = CHR$(  0,   0,   0, 126, 255, 153,  60, 126, 126)π  zero$ = CHR$( 56, 198, 198, 198,   0, 198, 198, 198,  56)π  one$  = CHR$( 24,  24,  24,  24,   0,  24,  24,  24,  24)π  two$  = CHR$( 56, 198,   6,   6,  56, 192, 192, 192,  62)π  thre$ = CHR$( 56, 198,   6,   6,  56,   6,   6, 198,  56)π  four$ = CHR$(198, 198, 198, 198,  56,   6,   6,   6,   6)π  five$ = CHR$( 62, 192, 192, 192,  56,   6,   6, 198,  56)π  six$  = CHR$(192, 192, 192, 192,  56, 198, 198, 198,  56)π  sevn$ = CHR$(248,   6,   6,   6,   0,   6,   6,   6,   6)π  eigt$ = CHR$( 56, 198, 198, 198,  56, 198, 198, 198,  56)π  nine$ = CHR$( 56, 198, 198, 198,  56,   6,   6, 198,  56)π  a$    = CHR$( 56, 198, 198, 198,  56, 198, 198, 198, 198)π  p$    = CHR$( 56, 198, 198, 198,  56, 192, 192, 192, 192)π  m$    = CHR$(126, 219, 219, 219,   0, 219, 219, 195, 195)ππ  start$    = STRING$(3, 0)    ' align topπ  tail$     = STRING$(4, 0)    ' align tailπ  between$  = STRING$(7, 0)    ' align prev. and next charππ  ' NOTE: if the characters don't bottom align versus defaultπ  '       font characters (e.g. the colon) then unmark the next line:ππ  ' SWAP start$, tail$ππ  pattern$  = start$ + cred$ + between$ + phon$ + between$ + zero$ + _π              between$ + one$ + between$ + two$ + between$ + thre$ + _π              between$ + four$ + between$ + five$ + between$ + six$ + _π              between$ + sevn$ + between$ + eigt$ + between$ + nine$ + _π              between$ + a$ + between$ + p$ + between$ + m$ + tail$ππ  REG %AX, &H1100               ' functionπ  REG %BX, 16 * 256             ' 16 bytes per char in BHπ  REG %CX, 15                   ' number of charactersπ  REG %DX, 224                  ' first char in ASCII-set to modifyπ  REG %ES, STRSEG(pattern$)π  REG %BP, STRPTR(pattern$)π  CALL INTERRUPT &H10π  REG %AX, &H1103               ' functionπ  REG %BX, 0π  CALL INTERRUPT &H10πEND SUBππ' Trim all spaces from both ends of a stringπFUNCTION TRIM(BYVAL text AS STRING) AS STRINGπ  FUNCTION = LTRIM$(RTRIM$(text))πEND FUNCTIONππFUNCTION TimeToDisplay AS STRINGπ  temp$ = TIME$π  IF NOT clok.secs THEN temp$ = LEFT$(temp$, 5)    ' skip secondsπ  hour = VAL(LEFT$(temp$, 2))π  extension$ = SPACE$(3)ππ  IF clok.twelve THENπ    SELECT CASE hourπ      CASE => 12π        IF hour > 12 THEN DECR hour, 12π        extension$ = " PM"π      CASE ELSEπ        IF hour = 0 THEN hour = 12π        extension$ = " AM"π    END SELECTπ  END IFππ  temp$ = TRIM(STR$(hour)) + MID$(temp$, 3) + extension$π  temp$ = temp$ + SPACE$(11 - LEN(temp$) )  ' fixed length = 11 charsππ  IF clok.font THENπ    FOR count = 48 TO 57π      REPLACE CHR$(count) WITH CHR$(count + 178) IN temp$π    NEXTπ    REPLACE CHR$(65) WITH CHR$(236) IN temp$π    REPLACE CHR$(80) WITH CHR$(237) IN temp$π    REPLACE CHR$(77) WITH CHR$(238) IN temp$π  END IFππ  FUNCTION = temp$πEND FUNCTIONππSUB TimeInfoπ  STATIC colonπ  IF flg.mono THENπ    attri = 112                               ' black on whiteπ  ELSEπ    attri = 121                               ' blue on whiteπ  END IFππ  Info$ = TimeToDisplayπ  IF colon = %NO AND clok.secs = %NO THENπ    REPLACE ":" WITH CHR$(32) IN Info$π    colon = %YESπ  ELSEπ    colon = %NOπ  END IFππ  NextChar = 1ππ  DEF SEG = VideoAddressπ  FOR offset = 102 TO 122 STEP 2               ' 11 characters + 11 colorsπ    character = ASC(MID$(Info$, NextChar, 1))π    POKE offset, characterπ    POKE offset + 1, attriπ    INCR NextCharπ  NEXTπ  DEF SEGπEND SUBππFUNCTION GetKeyπ  STATIC lastTime$ππ  DOππ    IF TIME$ <> lastTime$ THEN                 ' every secondπ      lastTime$ = TIME$π      TimeInfoπ    END IFππ  LOOP UNTIL INSTATππ  FUNCTION = CVI( INKEY$ + CHR$(0) )πEND FUNCTIONππSUB DemoMenuππ  ' menu textπ  COLOR 7, 0π  IF flg.vga THENπ    LOCATE 3, 4π    PRINT "F1  = toggle fonts"π  END IFπ  LOCATE 4, 4 : PRINT "F2  = toggle seconds"π  LOCATE 5, 4 : PRINT "F3  = toggle 12/24 hrs"π  LOCATE 6, 4 : PRINT "Esc = end of this demo"ππ  DOπ    KeyIn = GetKeyπ    SELECT CASE KeyInπ      CASE 27π        IF flg.vga THEN SCREEN 0, 0, 0, 0   ' restore default fontπ        CLSπ        SYSTEMπ      CASE 59 * 256                         ' F1π        IF NOT flg.vga THEN EXIT SELECTπ        IF clok.font THEN clok.font = %NO ELSE clok.font = %YESπ      CASE 60 * 256                         ' F2π        IF clok.secs THEN clok.secs = %NO ELSE clok.secs = %YESπ      CASE 61 * 256                         ' F3π        IF clok.twelve THEN clok.twelve = %NO ELSE clok.twelve = %YESπ    END SELECTπ  LOOPπEND SUBπππ' demo mainππCLSπ  COLOR 0, 7π  LOCATE 1, 1 : PRINT SPACE$(80);         ' dummy menu barπ  LOCATE 1, 4 : PRINT "Sample Menu Bar"ππ  clok.secs = %YES                        ' start with default TIME$π  CALL DemoMenuπENDπEgbert Zijlema                 TRAP KEYBOARD INACTIVITY       [e-mail]        08-19-96 (19:53)       PB                     99   2673     NOKEY.BAS   ' NOKEY.BAS  - how to trap keyboard inactivityπ' Author     : Egbert Zijlema ([e-mail])π' (up)Date   : August 19, 1996π' Language   : Power Basic 3.2π' Copyright  : Public Domainππ' This routine does not demonstrate a sophisticated screen saver.π' Its main purpose is to show the most simple method to trap keyboardπ' inactivity for a certain period of time.π' As a sample screen saver it turns the screen black, just to proofπ' that it really works.ππ' Most programmers use the TIMER FUNCTION to calculate the number ofπ' seconds before screen saver launch. This works. I used it myselfπ' until an hour ago. There is 1 small problem however: as soon asπ' the computer's clock passes midnight, TIMER is (re)set to zeroπ' which will cause an infinite loop - unless you correct it byπ' adding 86400 seconds every round, e.g.:ππ' start# = TIMERπ' DOπ'    now# = TIMERπ'    IF now# < start# THEN INCR now#, 86400  [ adjust for midnight]π'    IF now# - start# =>  .... THENπ'      (command to start screen saver)π'    END IFπ'π'    (code for keyboard trapping)π' LOOP UNTIL ........ππ' ---------------------------- begin code ---------------------------ππDEFINT A - ZπFUNCTION GetKey AS INTEGERπ  STATIC t$                     ' alias for TIME$π  DOππ    IF seconds = 30 THEN        ' half a minute for this demoπ      CALL BlackScreen          ' start screen saverπ      EXIT FUNCTIONπ    END IFππ    IF t$ <> TIME$ THEN         ' TIME$ changes every secondπ      t$ = TIME$π      LOCATE 1, 72 : PRINT t$   ' you may leave this outπ      INCR seconds              ' add 1π    END IFππ    KeyIn$ = INKEY$π  LOOP UNTIL LEN(KeyIn$)        ' until keypressππ  FUNCTION = CVI( KeyIn$ + CHR$(0) )πEND FUNCTIONππSUB BlackScreenπ  DEF SEG = &HB800              ' color card - use &HB000 for monochromeπ  OldScreen$ = PEEK$(0, 4000)π  COLOR 7, 0π  LOCATE , , 0                  ' hide cursorπ  CLSπ  DOπ  LOOP UNTIL LEN(INKEY$)π  POKE$ 0, OldScreen$π  DEF SEGπEND SUBππSUB MainMenuπ  DOπ    KeyIn = GetKeyπ    SELECT CASE KeyInπ      CASE 27π        CLSπ        SYSTEMπ      CASE ELSEπ        ' other keys not supported hereπ    END SELECTπ  LOOPπEND SUBππ' mainππCLSπ  COLOR 15, 0π  LOCATE 2, 4π  PRINT "NOKEY.BAS       - traps keyboard inactivity"π  LOCATE 3, 4π  PRINT "Author          : Egbert Zijlema"π  LOCATE 4, 4π  PRINT "Copyright status: Public Domain"π  LOCATE 10, 4π  PRINT "This screen will turn black after 30 seconds"π  LOCATE 11, 4π  PRINT "Press any key to restore it"π  COLOR 7π  LOCATE 14, 4π  PRINT "(or press Esc to finish this demo)"ππ  MainMenuπENDπErik Bruggema                  SPACE SHOWER DEMO              [e-mail]        08-15-96 (13:41)       QB, PDS                94  6196     SPACE.BAS   DEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"SPACE.ZIP",4^6:Z&=4375:?STRING$(50,177);πU"%up()%9%%%%-%oCd1FzC<ib13%%%#R%%%.%%%%xu%fhjS[gfx>k)dASZA/w\bzuπU")rT,3:2n?U<FGf=hEfBE;+FV1eEIaLx,\tE^O.)I>nOITHy-=(([r(#cuLml-z*πU"4t;<P>+6yp3#)bM-f>,?3Pcks26WO8I_mTA]FMSco8gA*[JK4/nrFP74h$4Bu:_πU"NY'ePvnpbo0DAj#aW(HJx4#&=,5I/8ZaAx<A9o?&CG2hZ\uXHnEOWSu>QTv*BS/πU"Xc5tLet/d#[K$0,2)D&)BhdrJJDqFseut<WQe/kyGGmu:o4PRi;%ul4mU\,$VVlπU"SE++f+17/<h,qDs'&)\30O#fkK03(Z_(H^HCv>YI]&pB+&\Cs&F%3&ITs.vU2<7πU"IcQM.Ej=QfnS'G2G(cI'9tZ>Qjal*sa*o?WWlf>V5GjGha*D5J.,DN#q.+=L$2(πU"WhcY;)6Id5478U/iCa/Ol]pJqpMWUuQUQGo-_no.jhN*lTvB&K'<]*6TE2$%$$QπU"Y6vjV%q=;L+PL1EU#[#jukUW3SXfTv>m7f-:?fI5(?DjfflarFYB251KNTEXVhKπU"^PVBU5>nLK<?K1,6M&isl;gofd'cgKc-73UVCC+omxNE+&Cymqg0V-f:fC/Ygi-πU"tIOC]>/g.2.2$3]*YZ835=9qYAF'U,p='47F\[hjF#&K'(>wf_j2?xWTZDcv06qπU"Enjg8OvM9=BrQV&:U^3J1X5zF\K4(ndV=z9aS8**4u[;v(QBUmVTt.Z0P.Q-D'QπU"7D3a/9[f7qahN^;&?WhU<.m*\l8ml>TswbQ,ZL;?_tm6O,td2L$i*-h(Da6;v.6πU"t*$]uxsgql$ZHlCN$q?<Sp&+,QsVrJ/Y$vC;stbf7&]'i)8?r?ppWT_.inu$Bt-πU"+*<gAI%pPLHVAINBhhoS;qXHWQSC+aP+kA#[3km&82Tidm0%mA\)vt_aPk>ZY]HπU"*C:0_<V.H=2Ll$eW,JJ8u9O5\%]QS_CRXn-Jz(K>V0#gCL$Ip_Uk1bV/sRe<]u.πU"0wYaAwVepJ-UCj)r[Q+qrr8.>iZOorATf$ajWNU77Uj+b6hiwE?l<e,.]tIo'uuπU"_R4Ct-vR40[v8Y>ljPYLBb%ycnR9Wnm;Xwd<q6C9=p?y2x[MqUDv,6ohomj,/]&πU"-7F/bc9GVjdGu=W4r8y^JIbfGso8Lmp\;kD7oXtgr#IwCAc:x8BLh.BH,bBb.8KπU"y^r6QiS4jq1'j%V7O)UA[w&AdnG$K+YaK74Mv-L6#Gb9BqJY8hbG]:3=O1n54CmπU"A^JoWouvaYjogvi1]d%y%olgb'cROhMkeBA.UIK_r2nGDenJ[1GN1tK-?Ia5UTBπU"H3?k)Y'1ir_dPaJsY*2J_hbuBo8M#uV>#8j*9>0xZc9_7Zp%UrCe&?r9SU*/KH]πU"Ka%-_^#bK%EqC8p%Xbw4Fbb.69\3oq+7HvL1<r+$;/k5hBP1hgzCJj&wwBrugJkπU"Ks6SGU1WtkcF5*6q/6X$DMKYvTE[?'tqWs1hOD*p>-1gU&B7pJ^gAU[7_COUb.EπU"?mJ<+PBJGHXHPK=]\oK(5h_&h1[fKvSPy,QB=5#nL9K8nm*,:n4aTH7Y>,*jWrpπU"5v*.j1w??i($O7o'7tRXn8OmF<gbQH/d,1z)qK9xAp:i>R/%[_5n8#e:]Y[lpOaπU"v3Qi=;X%L9lMBAM#WDVAJuauvKoLKSOqIHybHk+]j2<V'3Kp>;j32.a,4fU<sf5πU"$-Lxf-ztjSY?S[8ziEVHh#CgovumCQ:b1MjyodJ^lmCt#/1o2K*;NW)0D<]Yc78πU"f%oCD7J)=uxek7goIl4^B,_q5J+PfXVs-Z][U6.4;2wQJUaz((ZL;s178NQ<JFeπU"==5kOxcu.53bH*pb,C&mG3#;n3J$\yk.C2So6GhD8;[Q^::BVrJ'FUE,hEZs(KOπU"rf<p;a]8Ui?Ui5qNVNFB2rv:29IWMfS:>e7n40Ft>^$^asr04V>B1a=f&[aNpm(πU"6VH>_.j(1uzOUtkZoD>7kz0G$6[99]t+g8KaB;%g]Gsd]Zjhuo,**B.sp,J>kaMπU"G[RL6&JWtnSY'plRqtOcddLC[1d=3tpft\cTiOtWD82h(lI_U+noKZ<fS'+Cj=QπU"VT?q#MguKqO.QGL&<tJ5h%pTV^M#u\[Qgb6C]-4%$Jf^p)tK28Cp2JxWC2DA>VDπU"g-;8)$'\Zm_B8udFXTV6lgHI_T)GmizCZC6t9BX['AG*QUw5<;6cmQ:+RPQhUUmπU"Exvb\hu:&.s7oH'<$^EFGg'*]&:^(8DJ&8Qh_\g7GTS0+eFF5UXhGfe-tRA_#;dπU"2;_bWWB6UgGFlro=4=%^6bO=RuZMy18T+MW17HsnZc,G-TX$JPKFXgCUf3BAiA#πU"t%G/]OKGvB,\UC+%9XZK<>]LkfSD),kY8)oA2W.4]Ji&$UI3l/u*p,+DgENnd3WπU"*c-0\/t>,QNqgdP_nG=+iHO-acP:#HwQMc/V/R'W8jc8Jiif^PEl%CM*/g=vyLmπU"7c&(JZfSf^^bq/d8gsBeu^a*=G:trNoWgDk3JcaAe-nW#&JnKnPS[:Sf7s<qLw+πU"&ZPva.Am^-Q83CUh&,$ijibtmK=?eA$;Tp-#?iKPi?Ofp)7fM6XQ&?s=APC*,wPπU"O97;&^N(8b<4/s;4n(0TrWAF'aAu0.7:+\VT\uGY?w0E-k%scs/B:qYFte3z<JgπU"=A4X)3b(cm3hh\alT7g)c#r]%v<cy)Ax-p;-+/BM1UB#p?3FZ^5=,T[&)\W;G7:πU"2iLlZm0%#d*AvRit3-f*0bH;f4CQYoQp*p$T7'_SEjWfv9RcBrtg<y9e9>[fW[/πU"o%UpoKtS)5g,Q7oDgehA<=Y<^0L>QSv*JbOt7(a])(tQEc7qo?^)'Kf9E?LXsy&πU"T]G12TM'IA?(6=RS,9OB?S9u%SL8Srb*H\vI$evhCD<ULuX5\7XwUFs&m#bFszGπU"A>ex:f^j6bZUI1>CA,Be3g*#BFxTKE7tBu\$&qSkUq+T_jUXRD0Rae>NIXynN7hπU"i]:*[\d-:AEhd07K:ahb'jGoK'$3#r\$>Qi,W1-\(anGXJlt%[A&>29^f1zSQ5>πU"ghZ0]WDY,CXep]J'0VAiDK*17CLDUl0'5WM&X5?uAUFpd5gdVXV+kaUPN.z)u8yπU"ho?i6&a7JZ<NzjNP?,r&lmrFWGnW35]bi;lKg)P?f\,FP'b+O)n>g8.*FUeAIT'πU"7X4^RpKO3eP99Xjiq$5Ht<Xj%GwFwuEl_Ss8Bi=YX.3X-hZea?_0-_h'A7g)f\SπU")pO'G)\c^lTiX;6&FcMBAPFSgUf)wj\Kf3=Sr'vkgxu?k;]<=_QCqwj]SbdeVuYπU"#[C%Vs5di]#+g5t*v$QZ:3[L5AU^o/:8R8pDbd(kXd^h)Tu*S,Mje..H*?D+mOjπU"mZASj/)SJ]W^_E5*=/6C6n6s9+5\4p\$tl8wcNB_X<\tQ4o(I3Oua,Amum3JfEvπU"]22(<[k&UhdFPlOd885B8s7K&2Bm=wujp:A$k.J1y*Z?852ZE<jg0UYun4-ZPM\πU"nGbfr=U-(h]qUYV.tqYTF07OYXh(Vi[c0bfOO:G?>RFcs&0l[z8xLdq%oNY)^2-πU"m2KBwb9l/)#YL7&elAnT[xcNNK.Z3U%&J3w:>AItyhCIY:4E_x_bmw/FWQWKEz;πU"W>'<GQ\3Uk2D]7NUB;XM14d(Pr-smnyRld%v9=c3UlZ[K(VXgoj/,75zPzTAxdxπU",M7rtK_4>Ti^ul'^(ASP8I$YTEER%1/oIu/RZCjZ7C4=k*V>Bb]Mj/<gLFAuP-FπU"\4eVI$A?:kQa:$vs:ES)5Qr%4h#Q%KN+r)T7s42Lb*k4\n)Lev183eWR2T?a.GWπU"A(_kZfkiwIYxN<1F3WhtbkDFd5b;zdaP5wCT&FoO7nk*t=nSXPDez-CT(y?gW73πU")BNDkSmG+fIk,,Xn9O:K-xdCCqokA*Iqesj+:33]Y9hcZtvXZ;9tsDu%m0rUwPUπU"F?7qH8/<BQ+H5q)DPD9k=U?E4Uml4]\u9chHE;BMeDF7;7\6TPAm%#a5<G6</Q7πU"g3Wxc<(^Q:A;cMNjcsL:mSseC>+Z$zustLfFgpq0.?n]7amXdRIB80gJqSDxM9*πU"QT:uv<It,1tUUI(Jv&feqD&K(LaT2FoYST2JgY3T^mbTkcTOg<Iqw>'[Z75]_&:πU"jo%.b1vNy.dqN<iItYOx=iTry#4m)q6<\eO#<Xo:(KsP:82nh=UbE<n^Brl<RE$πU"9vr<+hNQ_?/Z\]Ak/i#GFiL'Rfin%8QMJ>ZHdbHKZ3lE0A[UZjQjhj$^U41/3D2πU"z+,TXc/?nb)\4&qX6O[_V4o>iq8hIuw=;ap'0bKiRSs],s;w^O4mg^P/_AhL/5YπU"/\e4vI#sIUW=N5-cbYJDua*+5n^<X<fSJ*m3<=f89?jx4;hxV10DUyZ1_Oq82/rπU"CNU5^smDu[3AoK^z+b2EgT#t#SW4%bh^&aBx3FV%*h786_\d6NT<e2Y+C].ICu%πU"+D>&XX=Q'TnVlH0ZMTFwbA=pj'O1'+?;0x^hEKM4[CU^uJS5X>CZ03DmR_=DjBjπU"+d-pr.*K_tjAg3&:4SJW$P+Au/],)G.,QAvUN(_BQ_?EYp$I.ck--^*-^.Kf*KsπU"&ZQU#mNGr+dXx^4fke_?E1_Q*X\OF=78:'eT$I=9j'DJ\2PfXQIH0&gsWV?0+<XπU"_0jke./G2BXGGPFG#JvSIK+q'L#c386.:8^XT0=Qpg8S]tY$hYxgidK<nJ(Sp**πU"gSzJ7J)LIF(RBTNWIA.VGn3r\bv0<SH%JT8y+3AcjQtqW'9A%6a.w=Rcx&S[)wHπU"N\1[9iBt,]F2teNi-GqJ-Xf]Dg<.B.-^x%u%p()9%%%%-(%Ll/aF:Yv*-^&%+%=πU")%%%-%%%%xuf%hjSg(ndyv,:,U98LTmdNUV=B6+:)=eC4J)mK_:?MastJ2C<)'IπU"zpu2<tMv<Qd%$tk[rGGQ2pmB.H<0d]oM+/&k&PyDXs'V/$OJ8aOR*kXEW:2.56]πU"hLq>VR0/E'7&nl.&sOK&'K3+VqVW]gOO+uDPIl[<oVS/#CaH-_iCPti-[GJd=%TπU"XgvGicP?gSw)\XLRt4*Vy]y/hE8KskY%-2Lz,Ro%\I-R>3c'O_gmN4B>I]YOhH*πU"F#g$G25VL$A[SY(_'0;R>jQZE0og5T?)<14h2QoGbMW&[J-Lu\Di#?$L5+g[k\NπU"?Wf\1YDiEKD<:x)S.OKxlW.]Fp6r'M=Wh_vx>OWhH=MVn:uOd$FuXDwg0#aV?)]πU"LuPciRb*JhfZ^]4LlHg5O6G9\:9jrN'?=:5H,UcM^su:cK?N*ddBOgc0h0GSfGcπU".GY?+0XA_b6JBkm0Hkq%?u\3'?23%4E'kwnr]BAwQ#oJ[4Yp7-o4R_y7l3iMU('πU"P<X0%6aY83b$d%up&'%9%9%%%%-%%oC1FYzCib'13%%%#R%%%.%%%%%%%%%&%E%πU"%%%%%%%%xu%fhjS%gfxu%p&'9%%9%%#%-%L[l/F:XYv-^[&%%=%)%%-%%%%%%%%πU"%&%%E%%+%X3%%%xuf%hjSg%nup*%+%%%%%'%'(%<%%(%c5%%%%%πEND SUBπCLOSE:IF S=137AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπPeter Norton                   FIND AVAILABLE BYTES ON DRIVE  Advanced BASIC Book            1990                   QB, PDS                37   936      DISKFREE.BASDECLARE FUNCTION DiskFree& (Drive$)ππTYPE RegTypeπ        ax      AS INTEGERπ        bx      AS INTEGERπ        cx      AS INTEGERπ        dx      AS INTEGERπ        bp      AS INTEGERπ        si      AS INTEGERπ        di      AS INTEGERπ        flags   AS INTEGERπEND TYPEππDECLARE SUB INTERRUPT (IntNo AS INTEGER, InRegs AS RegType, Outregs AS RegType)ππ        CLSπ        PRINT "The number of bytes free on drive C are: ", DiskFree&("C");π        PRINT "The number of bytes free on drive A are: ", DiskFree&("A");ππENDππFUNCTION DiskFree& (Drive$)ππ   DIM InRegs AS RegType, Outregs AS RegTypeππ   DiskFree& = -1π   IF LEN(Drive$) <> 1 THEN EXIT FUNCTIONππ   InRegs.ax = &H3600π   InRegs.dx = ASC(UCASE$(Drive$)) - ASC("A") + 1π   CALL INTERRUPT(&H21, InRegs, Outregs)π   IF Outregs.ax = -1 THEN EXIT FUNCTIONππ   Temp& = Outregs.axπ   DiskFree& = Temp& * Outregs.bx * Outregs.cxππEND FUNCTIONπEdward Blake                   BATCH PROCEDURES               [e-mail]          07-04-96 (19:54)       QB, PDS                154  5053     BATCH.BAS   ' 1996 Edward Blake (still 14 years old) Quebec, Canadaπ' Routines called from a Batch (.BAT) file. can be used for making a simpleπ' Installation batch program or anything else.π' uses the StrTok routine from the quickbasic example program Token.basπ' for tokenizing the command$π' Can't be used with QBasic because QBasic doesnt support Command$π'π' $INCLUDE: 'QB.BI'πDECLARE SUB READER (FILE$)πDECLARE SUB BCKGND ()πDECLARE SUB WIN (X1!, Y1!, X2!, Y2!, A$)πDECLARE FUNCTION StrTok$ (Source$, Delimiters$)πDECLARE SUB EXITWITHERRLEVEL ALIAS "_EXIT" (N AS INTEGER)πDIM TOK$(10)πIF COMMAND$ <> "" THENπP$ = COMMAND$πDELM$ = " ,;:()?" + CHR$(9) + CHR$(34)πTOKN$ = StrTok$(P$, DELM$)πWHILE TOKN$ <> ""π   TOK$(I) = TOKN$π   I = I + 1π   TOKN$ = StrTok$("", DELM$)πWENDπFOR I = 0 TO 10πTOK$(0) = UCASE$(LTRIM$(RTRIM$(TOK$(0))))πNEXT IπSELECT CASE TOK$(0)πCASE "BCKGND"πBCKGNDπCASE "COLOR"πCOLOR VAL(TOK$(1)), VAL(TOK$(2))πLOCATE 1, 1: PRINTπCASE "WIN"πWIN VAL(TOK$(1)), VAL(TOK$(2)), VAL(TOK$(3)), VAL(TOK$(4)), TOK$(5)πCASE "PROGRESS"πLOCATE VAL(TOK$(1)), VAL(TOK$(2)): PRINT STRING$(VAL(TOK$(3)) / 10, 219)πCASE "LOCATE"πLOCATE VAL(TOK$(1)), VAL(TOK$(2))πCASE "SELECTDRIVE"πWIN 20, 5, 40, 11, "Select Drive"πDOπI$ = INKEY$πIF I$ = CHR$(0) + CHR$(80) THEN Y% = Y% + 1πIF I$ = CHR$(0) + CHR$(72) THEN Y% = Y% - 1πIF I$ = CHR$(13) THEN EXIT DOπIF Y% = 0 THEN COLOR 15, 1 ELSE COLOR 7, 0πLOCATE 6, 21: PRINT "         A:        "πIF Y% = 1 THEN COLOR 15, 1 ELSE COLOR 7, 0πLOCATE 7, 21: PRINT "         B:        "πIF Y% = 2 THEN COLOR 15, 1 ELSE COLOR 7, 0πLOCATE 8, 21: PRINT "         C:        "πIF Y% = 3 THEN COLOR 15, 1 ELSE COLOR 7, 0πLOCATE 9, 21: PRINT "         D:        "πIF Y% = 4 THEN COLOR 15, 1 ELSE COLOR 7, 0πLOCATE 10, 21: PRINT "         E:        "πLOOPπEXITWITHERRLEVEL Y%πCASE "READER"πREADER TOK$(1)πEND SELECTπELSEπPRINT "▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒";πPRINT "▒▒╒══════════════════════════════════════════════════════════════════════════╕▒▒";πPRINT "▒▒│ Batch Procedures - 1996 Edward Blake                                     │▒▒";πPRINT "▒▒├──────────────────────────────[Commands]──────────────────────────────────┤▒▒";πPRINT "▒▒│Win x1 y1 x2 y2 title (note: no parameters are optional except title)     │▒▒";πPRINT "▒▒│bckgnd (note: all parameters are ignored)                                 │▒▒";πPRINT "▒▒│color num1 [num2] (note: default is 0 for all parameters!!)               │▒▒";πPRINT "▒▒│Progress x1 y1 value                                                      │▒▒";πPRINT "▒▒│selectdrive (note: will return a errorlevel 0=A 1=B 2=C 3=D 4=E,only A-E) │▒▒";πPRINT "▒▒│locate x1 y1 (use echo for displaying text)                               │▒▒";πPRINT "▒▒│Reader filename (must have the extension)                                 │▒▒";πPRINT "▒▒╘══════════════════════════════════════════════════════════════════════════╛▒▒";πPRINT "▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒";πEND IFππSUB BCKGNDπFOR I = 1 TO 24πLOCATE I, 1: PRINT STRING$(80, 177);πNEXT IπLOCATE 25, 1: PRINT STRING$(80, 177);πEND SUBππSUB READER (FILE$)πDIM FILEC$(500)πOPEN FILE$ FOR INPUT AS #1πDO UNTIL EOF(1)πINPUT #1, FILEC$(I)πI = I + 1πLOOPπCLOSE #1πCOLOR 7, 1πY = -1πDOπI$ = INKEY$πIF I$ = CHR$(0) + CHR$(80) THEN Y = Y + 1πIF I$ = CHR$(0) + CHR$(72) THEN Y = Y - 1πIF I$ = CHR$(27) THEN EXIT DOπIF Y < -1 THEN Y = -1πIF Y > 474 THEN Y = 474πFOR I = 1 TO 25πLOCATE I, 1, 0: PRINT FILEC$(I + Y) + STRING$(80 - (LEN(FILEC$(I + Y))), 32);πNEXT IπLOOPπCOLOR 7, 0πCLSπEND SUBππFUNCTION StrTok$ (Srce$, Delim$)πSTATIC Start%, SaveStr$ππ   ' If first call, make a copy of the string.π   IF Srce$ <> "" THENπ      Start% = 1: SaveStr$ = Srce$π   END IFππ   BegPos% = Start%: Ln% = LEN(SaveStr$)π   ' Look for start of a token (character that isn't delimiter).π   WHILE BegPos% <= Ln% AND INSTR(Delim$, MID$(SaveStr$, BegPos%, 1)) <> 0π      BegPos% = BegPos% + 1π   WENDπ   ' Test for token start found.π   IF BegPos% > Ln% THENπ      StrTok$ = "": EXIT FUNCTIONπ   END IFπ   ' Find the end of the token.π   EndPos% = BegPos%π   WHILE EndPos% <= Ln% AND INSTR(Delim$, MID$(SaveStr$, EndPos%, 1)) = 0π      EndPos% = EndPos% + 1π   WENDπ   StrTok$ = MID$(SaveStr$, BegPos%, EndPos% - BegPos%)π   ' Set starting point for search for next token.π   Start% = EndPos%ππEND FUNCTIONππSUB WIN (X1, Y1, X2, Y2, A$)πFOR I = Y1 TO Y2πLOCATE I, X1: PRINT STRING$(X2 - X1, 32);πNEXT IπLOCATE Y1, X1 + 1: PRINT STRING$(X2 - X1 - 1, 196);πLOCATE Y2, X1 + 1: PRINT STRING$(X2 - X1 - 1, 196);πFOR I = Y1 + 1 TO Y2 - 1πLOCATE I, X1: PRINT CHR$(179);πLOCATE I, X2: PRINT CHR$(179);πNEXT IπLOCATE Y1, X1: PRINT CHR$(218);πLOCATE Y1, X2: PRINT CHR$(191);πLOCATE Y2, X1: PRINT CHR$(192);πLOCATE Y2, X2: PRINT CHR$(217);πIF A$ <> "" THENπLOCATE Y1, ((X2 + X1) / 2) - ((LEN(A$) + 2) / 2): PRINT " " + A$ + " "πEND IFπEND SUBπJoe Negron                     FILE HANDLES                   FidoNet QUIK_BAS Echo          07-15-96 (21:44)       QB, PDS                56   1745     HANDLES.BAS '> In the CONFIG.SYS file, put the line FILES=20, or howeverπ'> many you need and your version of DOS will tolerate.ππ'No, it's not quite that simple.  The FILES directive in CONFIG.SYSπ'specifies the maximum number of file handles the *system* (not program)π'will allow.  But, that does not mean that a particular program will beπ'able to open that many files simultaneously.ππ'The .EXE's PSP has a 20 byte file handle table (which leaves only 15 forπ'your program since DOS uses 5 file handles).  The FUNCTION below,π'SetMaxFiles%(), calls a DOS interrupt which points the file handle tableπ'pointer to a larger area of memory.ππ'SETMEM() is needed because, by default, BASIC grabs all availableπ'memory.  Passing SETMEM() a negative value tells BASIC to give up thatπ'much memory (in this case, 384 bytes is enough for at least 100 fileπ'handles).ππDEFINT A-Zππ'$INCLUDE: 'qb.bi'ππDECLARE FUNCTION SetMaxFiles% (NumFiles%)ππX% = SetMaxFiles% (100)ππFOR I% = 1 TO 100π   Num$ = MID$(STR$(I%), 2)π   OPEN STRING$(8 - LEN(Num$), "0") + Num$ + ".dat" FOR OUTPUT AS #I%πNEXT I%ππCLOSEπENDππ'***********************************************************************π'* FUNCTION SetMaxFiles%π'*π'* PURPOSEπ'*    Uses DOS ISR 21H, Function 67H (Set Maximum Handle Count) to setπ'*    the maximum number of handles.π'***********************************************************************πFUNCTION SetMaxFiles% (NumFiles%) STATICπ   DIM Regs AS RegTypeππ   X& = SETMEM(-384)π   Regs.ax = &H6700π   Regs.bx = NumFiles%ππ   Interrupt &H21, Regs, Regsππ   IF (Regs.flags AND 1) = 1 THENπ      SetMaxFiles% = Regs.ax                 'Error numberπ   ELSEπ      SetMaxFiles% = 0π   END IFπEND FUNCTIONπRonald Kas                     READING FILES FROM DIRECTORY   FidoNet QUIK_BAS Echo          08-16-96 (20:11)       QB, QBasic, PDS        76   2533     READFILE.BAS' > Does anyone know how to get the list(s) of files in a certianπ' > driectory?? Without using the shell "dir" command?? can you use theπ' > bois absolute disk read to read the fat table??  I know there areπ' > simpler ways to do this, but I am wondering how the DIR command doesπ' > it... Such as to write my own, with out ANY shelling....ππ' It is not so easy, but it can surely be done.π' You have to use an Interrupt to get the DTA of a file.π' Here is an exemple (I don't know if it works in QuickBasic, but I knowπ' it works in Qbasic. So if it doesn't work in QuickBasic, try it inπ' Qbasic.)ππDECLARE SUB ReadFiles (pad$, masker$, Bestanden$(), BestLengte&(), BestAantal%)πDECLARE SUB ReadData ()πDECLARE FUNCTION Interr% (num%, AX%, BX%, CX%, DX%)πDIM Bestanden$(200), BestLengte&(200)πDIM SHARED MS%(30)πCLSπReadDataπReadFiles "", "*.*", Bestanden$(), BestLengte&(), BestAantal%πPRINTπPRINT BestAantal%; "Bestandengevonden"ππFOR i = 1 TO BestAantal%π        PRINT Bestanden$(i), BestLengte&(i)π        PRINT ,πNEXT iπPRINTππMS.Data:π        DATA 55,8b,ec,56,57π        DATA 8b,76,06,8b,14π        DATA 8b,76,08,8b,0cπ        DATA 8b,76,0a,8b,1cπ        DATA 8b,76,0c,8b,04π        DATA cd,21π        DATA 8b,76,0c,89,04π        DATA 5f,5e,5dπ        DATA ca,08,00π        DATA #ππFUNCTION Interr% (num%, AX%, BX%, CX%, DX%)π        IF MS%(0) = 0 THEN PRINT "FOUT": ENDπ        DEF SEG = VARSEG(MS%(0))π        POKE VARPTR(MS%(0)) + 26, num%ππ        CALL ABSOLUTE(AX%, BX%, CX%, DX%, VARPTR(MS%(0)))π        Interr% = AX%πEND FUNCTIONππSUB ReadDataπ        RESTORE MS.Dataπ        DEF SEG = VARSEG(MS%(0))π        FOR i = 0 TO 99π                READ byt$π                IF byt$ = "#" THEN EXIT FORπ                POKE VARPTR(MS%(0)) + i, VAL("&H" + byt$)π        NEXT iπEND SUBππSUB ReadFiles (pad$, masker$, Bestanden$(), BestLengte&(), BestAantal%)π        DTA$ = STRING$(80, " ")π        AX% = Interr%(&H21, &H1A00, 0, 0, SADD(DTA$))π        BestAantal% = 0π        FileName$ = pad$ + masker$ + CHR$(0)π        AX% = Interr%(&H21, &H4E00, 0, 32, SADD(FileName$))ππ        WHILE AX% < 18π                f$ = MID$(DTA$, 31, 12)π                IF INSTR(f$, CHR$(0)) THEN f$ = LEFT$(f$, INSTR(f$, CHR$(0)) - 1)π                BestAantal% = BestAantal% + 1π                Bestanden$(BestAantal%) = f$π                BestLengte&(BestAantal%) = CVL(MID$(DTA$, 27, 4))π                AX% = Interr%(&H21, &H4F00, 0, 0, 0)π        WENDπEND SUBπSteven Anthony Morisi          ETCH-A-SKETCH                  [e-mail]         05/96 (00:00)          QB, QBasic, PDS        194  3577     ETCH.BAS    DECLARE SUB instructions ()πDECLARE SUB pause ()πDECLARE SUB errtone ()πDECLARE SUB drawetch ()πDECLARE SUB quake ()π'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''π' Program  :  Etch Etch     Date : 5/96π' Author   :  Steve Morisiπ' Comments :  Not much to the program but my son & daughter ( 8 & 12)π'             thought it was cute. Also I did use 2 snippets from theπ'             ABC packets.π'             My son Paul Anthony thought of incorporating the QUAKEπ'             as a sub routine.    π'             Credit for the Quake code goes to William Yu. It was in oneπ'             of the ABC packets in the Graphic section under the name ofπ'             EARTHQUAKE EFFECT DEMO.π'π'             Another snippet I used was ENDS.BAS written by RATBOYπ'             If you invoke the code by QBASIC /RUN ETCHπ'             then when you end the program you'll back out to theπ'             prompt rather than the QBASIC editor.π'π'             I'd appreciate any comments/suggestions atπ'             [e-mail]π'π'             Thanksπ'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''π'etch a sketch emulatorπDIM box%(1 TO 30000)ππSCREEN 9πx = 280πy = 175ππ'Assign names to colorsπblue = 1πgreenB = 2πcyan = 3πred = 4πmagenta = 5πrust = 6πwhite = 7πgrey = 8πblueB = 9πgreen = 10πcyanB = 11πorange = 12πmagentaB = 13πyellow = 14πwhiteB = 15ππ'Set up keysπKEY(2) ON    'F2πKEY(11) ON   'Up arrowπKEY(12) ON   'LeftπKEY(13) ON   'RightπKEY(14) ON   'Downπinstructionsπdrawetch ' initialize drawing areaππ'Drawing routineπDO WHILE (key.Press$ <> CHR$(27))ππ   PSET (x, y), 0π   key.Press$ = INKEY$ππ   ON KEY(2) GOSUB newscreenπ   ON KEY(11) GOSUB arrow.upπ   ON KEY(12) GOSUB arrow.leftπ   ON KEY(13) GOSUB arrow.rightπ   ON KEY(14) GOSUB arrow.downππLOOPπCLSπSYSTEMπREM CHAIN "menu"πENDππarrow.up:πIF y < 76 THENπ   errtoneπ   RETURNπEND IFπy = y - 1π   πRETURNππarrow.left:πIF x < 121 THENπ   errtoneπ   RETURNπEND IFπx = x - 1πRETURNππarrow.right:πIF x > 439 THENπ   errtoneπ   RETURNπEND IFπx = x + 1πRETURNππarrow.down:πIF y > 274 THENπ   errtoneπ   RETURNπEND IFπy = y + 1πRETURNππnewscreen:π  quakeπ  CLS 0π  drawetchπ  x = 280π  y = 175πRETURNππSUB drawetchπerrtoneπ'colorsπblue = 1πgreenB = 2πcyan = 3πred = 4πmagenta = 5πrust = 6πwhite = 7πgrey = 8πblueB = 9πgreen = 10πcyanB = 11πorange = 12πmagentaB = 13πyellow = 14πwhiteB = 15πππ'draw etch sketchπLINE (120, 75)-(440, 275), blueB, BπLINE (70, 30)-(500, 330), blueB, BπPAINT (1, 1), cyan, blueBπPAINT (71, 31), red, blueBπPAINT (121, 76), grey, blueBπCIRCLE (145, 300), 20, blueBπCIRCLE (410, 300), 20, blueBπPAINT (400, 300), white, blueBπPAINT (150, 300), white, blueBππ'textπLOCATE 2, 26πPRINT " F2=CLEAR  ESC=QUIT "πLOCATE 22, 22πPRINT "  Etch Etch by MorisiWare  "πLOCATE 23, 22πPRINT "      Copyright 1996       "ππEND SUBππSUB errtoneπSOUND 450, 2πSOUND 500, 4πSOUND 450, 2ππEND SUBππSUB instructionsπSCREEN 9πCLSπFOR i = 50 TO 90 STEP 5πLINE (125, 1 + i)-(500, 250 - i), 3, Bπ'LINE (125, 1 + i + 1)-(500, 5 + i), 4, BπFOR delay% = 1 TO 15000: NEXT delay%πNEXT iπLOCATE 9, 18πPRINT " Draw by using Arrow keys on the Number Pad "πLOCATE 11, 18πPRINT "               Press Enter                  "πpauseπEND SUBππSUB pauseπDO UNTIL INKEY$ <> ""πLOOPπEND SUBππSUB quakeπdelay = 5500πFOR x = 1 TO delayπOUT &H3D4, 8: OUT &H3D5, xπNEXT xππEND SUBπKurt Kuzba                     WRITING PIXELS IN MODE 12H     FidoNet QUIK_BAS Echo          06-22-96 (00:00)       QB, QBasic, PDS        48   2029     PUTPIX12.BAS'   I also worked out a pixel location algorithm for 4-planeπ'graphics memory and designed a mode 12h putpixel with it.π'Notice that there is a four-step process in the pix12 routineπ'which could be served by a FOR/NEXT loop. Unrolling such loopsπ'is a standard method of speed optimization.ππ'_|_|_|   PUTPIX12.BASπ'_|_|_|   An example of writing pixels in video mode 12h.π'_|_|_|   No warrantees or guarantees are given or implied.π'_|_|_|   Released to   PUBLIC DOMAIN   by Kurt Kuzba.  (6/22/96)πDEFINT A-ZπDECLARE SUB pix12 (vertical%, horizontal%, c%)πDIM SHARED bitfield(7) AS INTEGERπ   bitfield(0) = 128: bitfield(1) = 64: bitfield(2) = 32π   bitfield(3) = 16: bitfield(4) = 8: bitfield(5) = 4π   bitfield(6) = 2: bitfield(7) = 1πSCREEN 12πFOR y = 0 TO 639: pix12 y / 1.3, y, 5: NEXTπFOR y = 0 TO 639: pix12 479 - (y / 1.3), y, 14: NEXTπFOR y = 0 TO 639: pix12 y / 1.3, y, 14: NEXTπFOR y = 0 TO 639: pix12 479 - (y / 1.3), y, 5: NEXTπFOR c = 15 TO 0 STEP -1π   FOR y = 308 - 5 * c TO 316 + 5 * cπ      FOR x = 234 - 5 * c TO 242 + 5 * cπ         pix12 x, y, c: IF INKEY$ <> "" THEN SCREEN 0: ENDπ      NEXTπ   NEXTπNEXT: WHILE INKEY$ = "": WEND: SCREEN 0πSUB pix12 (vertical%, horizontal%, c%)π   IF (vertical% < 0) OR (horizontal% < 0) THEN EXIT SUBπ   IF (vertical% > 479) OR (horizontal% > 639) THEN EXIT SUBπ   DEF SEG = &HA000: OUT &H3CE, 4: OUT &H3C4, 2π   P& = vertical%: P& = P& * 80 + horizontal% \ 8π   bit% = bitfield(horizontal% AND 7): bitmask% = 255 - bit%π   OUT &H3CF, 0: OUT &H3C5, 1: B% = PEEK(P&) AND bitmask%π   IF (c% AND 1) <> 0 THEN B% = B% OR bit%π   POKE P&, B%π   OUT &H3CF, 1: OUT &H3C5, 2: B% = PEEK(P&) AND bitmask%π   IF (c% AND 2) <> 0 THEN B% = B% OR bit%π   POKE P&, B%π   OUT &H3CF, 2: OUT &H3C5, 4: B% = PEEK(P&) AND bitmask%π   IF (c% AND 4) <> 0 THEN B% = B% OR bit%π   POKE P&, B%π   OUT &H3CF, 3: OUT &H3C5, 8: B% = PEEK(P&) AND bitmask%π   IF (c% AND 8) <> 0 THEN B% = B% OR bit%π   POKE P&, B%πEND SUBπ'_|_|_|   end   PUTPIX12.BASπTika Carr                      GUI PROGRAMMER'S LIBRARY V1.23 FidoNet QUIK_BAS Echo          08-09-96 (17:04)       QB, PDS                259  6892     GUI123.BAS  'GUI123.BAS 8/9/96π'GUI Interface Programmer's Library v. 1.23π'for QuickBasic 4.5π'Copyright 1996 by Tika Carrππ'Contact:π'Tika Carr 1:2613/601π'[e-mail]ππDECLARE SUB clrscrn (clr%)πDECLARE SUB drwbtn (ds%, dc%, dfs%, dfc%, dx1%, dy1%, dx2%, dy2%)πDECLARE SUB gprint (z$, x%, y%, c%)πDECLARE SUB Mouse (a%)πDECLARE SUB PopInp (Prompt$, T2Len%, x1%, y1%, CurClr%)ππ'$INCLUDE: 'qb.bi'ππCOMMON SHARED mb%, mi%, mt%, mx%, my%        'mouse variablesπCOMMON SHARED black%, white%                 'used for paletteπCOMMON SHARED T2$                            'PopInp resultsπDIM SHARED Inregs AS RegType, Outregs AS RegType        'InterruptπDIM SHARED Regs AS RegTypeX                             'InterruptXππSCREEN 12: CLS      '640 x 480 16 color VGA 80 x 30 textππ'** PALETTE ASSIGNMENT **ππ' Color 0 and Color 15 are system colors (black and white) and shouldπ' not be changed as they are used for buttons and such.ππblack% = 0: white% = 15ππDEFINT A-ZππWIDTH 80, 60ππ'Clear the screen to color #3 (Cyan)πCALL clrscrn(3)ππ'Change white to be 7, causing the boarder highlight to be greyπ'instead of white. Change the menu bar to be white, then draw menuπ'bar, and change white back to color #14 (white)ππwhite = 7πCALL drwbtn(2, 15, 0, 0, 0, 0, 639, 20)πwhite = 15ππ'The "Exit" box in the upper left.πCALL drwbtn(2, 7, 0, 0, 2, 2, 18, 18)πCALL gprint("X", 6, 4, 0)ππ'The "Help" box in the upper right.πCALL drwbtn(2, 7, 0, 0, 619, 2, 637, 18)πCALL gprint("?", 624, 4, 0)ππ'Menu OptionsπCALL gprint("File", 55, 3, 0)πCALL gprint("Edit", 107, 3, 0)ππ' A boxed frame text boxπCALL drwbtn(4, 9, 10, 1, 10, 30, 629, 459)ππ' Some text in the boxπa$(1) = "Here is an example of some things you can do in the GUI interface."πa$(2) = "I want to thank Douglas H. Lusher for his help in writing the gprint"πa$(3) = "routine. He developed a faster way to print text on the screen. This"πa$(4) = "routine does what the PRINT statement can't: Prints text virtually"πa$(5) = "anywhere on the screen, and transparently over the graphics."ππy = 34πFOR g = 1 TO 5π    y = y + g + 16π    CALL gprint(a$(g), 32, y, 14)πNEXT gππStart:π'Loop to trap mouse eventsπCALL Mouse(0)       'initialize mouseπCALL Mouse(1)       'show mouseππWHILE mb = 0        'trap eventsπ    CALL Mouse(3)π    LOCATE 60, 1π    PRINT mx, my, mb;πWENDππ'The "Exit" box in the upper left clicked on.πIF mx > 2 AND my > 3 AND mx < 18 AND my < 18 THENπ    CALL Mouse(2)   'hide mouseπ    CALL drwbtn(1, 7, 0, 0, 2, 2, 18, 18)π    CALL gprint("X", 6, 4, 0)π    FOR delay = 1 TO 30000: NEXTπ    CALL drwbtn(2, 7, 0, 0, 2, 2, 18, 18)π    CALL gprint("X", 6, 4, 0)π    CALL PopInp("Do You Really Want To Quit?", 1, 160, 120, 3)π    IF LCASE$(T2$) = "n" THEN RUN ELSE ENDπEND IFππGOTO StartππSUB clrscrn (clr%)πLINE (0, 0)-(639, 479), clr%, BFπEND SUBππSUB drwbtn (ds, dc, dfs, dfc, dx1, dy1, dx2, dy2)πIF ds >= 3 AND ds <= 6 THEN c = dfc ELSE c = dcπSELECT CASE dsπ    CASE 1: GOSUB dOnπ    CASE 2: GOSUB dOffπ    CASE 3: GOSUB dOn: GOSUB Inside: GOSUB dOffπ    CASE 4: GOSUB dOff: GOSUB Inside: GOSUB dOnπ    CASE 5: GOSUB dOn: GOSUB Inside: GOSUB dOnπ    CASE 6: GOSUB dOff: GOSUB Inside: GOSUB dOffπ    CASE 7: GOSUB Dsquπ    CASE 8: GOSUB Dsqu: LINE (dx1, dy1)-(dx2, dy2), black%: LINE (dx1, dy2)-(dx2, dy1), black%π    CASE 9: GOSUB Dcirπ    CASE 10: GOSUB Dcir: CIRCLE (dx1, dy1), (15 - dfs) \ 2, dfc: PAINT (dx1, dy1), dfc, dfcπEND SELECTππGOTO DdoneππDsqu:π    LINE (dx1, dy1)-(dx2, dy2), black%, Bπ    PAINT (dx2 - 4, dy2 - 4), c, black%πRETURNππDBold:π    GOSUB Dsquπ    LINE (dx1 + 1, dy1 + 1)-(dx2 - 1, dy2 - 1), black%, BπRETURNππdOn:π    GOSUB DBoldπ    LINE (dx1 + 1, dy2 - 1)-(dx2 - 1, dy2 - 1), white%π    LINE -(dx2 - 1, dy1 + 1), white%πRETURNππdOff:π    GOSUB DBoldπ    LINE (dx1 + 1, dy2 - 1)-(dx1 + 1, dy1 + 1), white%π    LINE -(dx2 - 1, dy1 + 1), white%πRETURNππDcir:π    CIRCLE (dx1, dy1), dfs, black%π    PAINT (dx1, dy1), dc, black%πRETURNππInside:π    dx1 = dx1 + dfs: dy1 = dy1 + dfsπ    dx2 = dx2 - dfs: dy2 = dy2 - dfsπ    c = dcπRETURNππDdone:πdx1 = dx1 - dfs: dy1 = dy1 - dfsπdx2 = dx2 + dfs: dy2 = dy2 + dfsππEND SUBππSUB gprint (z$, x%, y%, c%)πRegs.ax = &H1130πRegs.bx = &H600πCALL INTERRUPTX(&H10, Regs, Regs)πCharSegment% = Regs.es: CharOffset% = Regs.bpπCharWid% = 8: CharHgt% = 16ππDEF SEG = CharSegment%πXX% = xπFOR Char% = 1 TO LEN(z$)π   Ptr% = CharHgt% * ASC(MID$(z$, Char%, 1)) + CharOffset%π   FOR Ln% = 0 TO CharHgt% - 1π     BitPattern& = PEEK(Ptr% + Ln%) * 256&π     LineFormat% = (BitPattern& - 32768) XOR -32768π     LINE (XX%, y + Ln%)-STEP(CharWid% - 1, 0), c, , LineFormat%π   NEXTπ   XX% = XX% + CharWid%πNEXTπDEF SEGπEND SUBππSUB Mouse (a%)πInregs.ax = a%πCALL INTERRUPT(&H33, Inregs, Outregs)πmb = Outregs.bx     'button 0 = off 1 = left 2 = rightπmx = Outregs.cx     'x coordinateπmy = Outregs.dx     'y coordinateπmi = Outregs.ax     'init (dummer variable)ππEND SUBππDEFSNG A-ZπSUB PopInp (Prompt$, T2Len%, x1%, y1%, CurClr%)ππIF LEN(Prompt$) > T2Len% THEN PBoxLen = LEN(Prompt$) ELSE PBoxLen = T2Len%πx2% = x1% + (PBoxLen + 2) * 8: y2% = y1% + 64: nx = x1%: ny = y1%ππCALL Mouse(2)πBitsPerPixel = 1: planes = 4        'Screen Mode 12πAry% = 4 + INT(((x2% - x1% + 1) * (BitsPerPixel) + 7) / 8) * planes * ((y2% - y1%) + 1)ππDIM VScreen(1 TO Ary%)πGET (x1%, y1%)-(x2%, y2%), VScreenππCALL drwbtn(2, 7, 0, 0, x1%, y1%, x2%, y2%)πx1% = x1% + 8πCALL gprint(Prompt$, x1%, y1% + 8, 0)ππInloop:πy1% = y1% + 32π'Input FieldπCALL gprint(">", x1%, y1%, 0)πCALL gprint(STRING$(T2Len%, 219), x1% + 8, y1%, 15)ππ'** Turn on and show cursorπx1% = x1% + 8πcursor$ = CHR$(219)πCALL gprint(cursor$, x1%, y1%, 4)ππ'** Get Input and move cursorππT2$ = ""π1 T1$ = INKEY$: IF T1$ = "" THEN 1 'wait for keypressπst = ASC(T1$)ππ'Backspace and eraseππIF st = 8 THENπ        'checks to make sure its in fieldπ        x1% = x1% - 8: IF x1% < nx + 16 THEN x1% = nx + 16: GOTO 1π        CALL gprint(cursor$, x1% + 8, y1%, 15)π        CALL gprint(RIGHT$(T2$, 1), x1%, y1%, 0)π        CALL gprint(cursor$, x1%, y1%, 4)π        'subtracts deleted character from stringπ        IF LEN(T2$) >= 1 THEN T2$ = LEFT$(T2$, LEN(T2$) - 1)π        GOTO 1πEND IFππIF T1$ = CHR$(13) THEN GOTO 2  'End of input when ENTER is pressed.ππIF st < 32 OR st > 127 THEN BEEP: GOTO 1  'check for illegal characterππT2$ = T2$ + T1$πCALL gprint(cursor$, x1%, y1%, 15)πCALL gprint(T1$, x1%, y1%, 0)πx1% = x1% + 8π'checks to make sure its in fieldπIF x1% > (nx + T2Len% * 8 + 8) THEN BEEP: GOTO 1πCALL gprint(cursor$, x1%, y1%, 4)ππ'Get more inputπGOTO 1ππ2 'Erase menu, restore what was underneathπPUT (nx, ny), VScreen, PSETπERASE VScreenπCALL Mouse(1)ππEND SUBπKris Reeves                    QUICK MAZE MAKER               [e-mail]           08-20-96 (15:44)       QB, QBasic, PDS        179 11255    QMM.BAS     'Batch Installation instructions:π'You MUST have PKUNZIP in your path statement for the install batch program toπ'work. it would be best if you extract the zip file and the install batchπ'program into the C:\  directory. Otherwise, you will need to move the QMMPROπ'directory to your root directory after installation.ππ'Manual Installation instructions:π'Make a directory named "QMMPRO" on the root directory. move the zip file toπ'this directory. Unzip the ZIP file USING THE STORED PATHS (-d switch ifπ'you're using PKUNZIP).ππ'To Run QMazMakrPRO:π'>From the DOS prompt in the C:\QMMPRO directory, simply type: QMMPRO <ENTER>π'This program is made to run from DOS and quit back to dos, so if you haveπ'QBASIC, you don't have to fiddle around inQbasic with running and quitting.ππ'Notes:π'This is the first program I've ever completed and uploaded somewhere. I wouldπ'really appreciate comments on any aspect of the program, suggestions, etc.π'Please write me about the "Checking" feature explained in the .BAS file! I'mπ'a little confused as to whether or not i even need that! Also, I have littleπ'experience with saving files and doing so efficiently. Please tel me if youπ'know of a better way to save my files!ππ'You can e-mail me at [e-mail] with comments, suggestions,π'questions, or problems.ππ'I plan on making installation improvements and some other stuff in the futureπ'if enough people like this program, including much more flexibleπ'installation, possibly taking out the "Checking" feature (explained in theπ'.BAS file) and compressing saved maze files.ππ'Thanks for trying out QMazMakrPRO!ππDEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"QMM.ZIP",4^6:Z&=6937:?STRING$(50,177);πU"%up()%9%%%#%%wS%1F%%%%%%%%%%%%%%%+%%%%rf&)jxT%up()%/%%%I%%zU71FπU"XT%9LF%%%%F%%%%0%%%%hf%yfqt%lSrr%uEXE%2/ij%rtrf&)j2/%ijrt/.y&t%πU"2/ij.rt.X%2/up%()9%%'%-%(3Y1FB6kc[%>%%%%M%%%%/%%%%vrru%wtSh%klxπU"UmWzY^7wU-)A$5[g3mFB(..#QJ&P)%u%p()9%%'%-.%yY1CFq3N%Z.7%1%j3%%%πU"/%%%%vrr%uwtS[gfxfjaTATs]+h'fkdC1DxYYadBpEeN=26&D$8p4AXyiH9.^.TπU"N-S'+Lpsfs/1P.Z9lb,z*$&3?'Y*Efq,;HeLA&'dA')?L%h\S2sYX9kr$BPwQW.πU">LuanFfo&:IPX01mlO%sSK[H&*$^RIB6b0bUoH9ngg-R0)?K?<gH52$zXT+h#B%πU"(-b-XL-fluhVqoS;<S#;R$f8t?7;;ejxKl&OuegEJKL?:h+[Xs)iNlP6lx,5TdHπU"=+v%wA-p/#o)W$u5'S0igTJ*o[/OBO8g'T#60tOGc*;+8=Ur;pUq[0[VClgM&e[πU"4gQ]X-)l&j#7U$oz9NWAjFW%#+zE<Z70//Fx1xt5BGEMEuO34g1;Cu.s&8k(=mRπU"PrV02308Ev<M0<=699Spo<A;)BN=uK,.EP=u-S?^[P/Uj0g-ra2D=XQP_f]8tPfπU"W+us(A7<8?U#PcBjV-45D1_BoDl$w7sA]a;&5:$u36H7,C/SL8EL2s/VqrH)PwRπU"sY)L<X-9\rTFed:NP*l+'prmBjVr[$$FxesnsDjWBWpwB\w3E50aS8ZG)$%UFoYπU"2EOH&/68s3aaDJ7O-vQFXi#D5lR>)GF1'F-5%]mT-#bD^umUX?Osb^?ZU;AHItTπU"1Wue5'F=N4jqD1Ud2,?Hhga4d]\xT&VT?\uxS+EfI9x44XWDa]AKctC]FgAK7)[πU"aCkr*MLDuc0j$jG<-vL*_tK3Qst%XEVB79Tq8m:)fj*J,M8EJLuV+Y%^V7eTYOHπU"PEiY[/9L$G7-nDM%RN8S0JuI;G/cIHSs_\=ZoqiPWb1e&N*M\]4%V2IFUhP_NP.πU">S7xh;6uje5%U'Snf,tm\TT?4*Iy+h<-9<WAEXS?ih28R7-BC>)GZD=qeir#%yQπU"c?Ll2XaU</1=zR0vm<eaE^-E>,hkwB$rZzf&cf&X6WR8mDF]8Wi5R/8e1DD(W-_πU",?Y(Q7#(Tvgh&SP;MTqQASKH3s)6W7LXkBt&J*.wypr/yPW$fHzCfM*q;0kHL>cπU"bi?amV'<'u6\R2ZpW*9NJ>=65-0vd_j1S,6l864.juH)lienn4rV-XM-/0q(rmMπU"Xe*<T^U9:Y49G.40%DZ1aRTguI]G+LOyB*c4Z/z/*Jo<&&0X+v/#XF0u1O9MkJ[πU"cNgs9BCV;F7]B*^u:s#9D&3I+-e#wB9yy*^TyS=D9NLTSa?l(/f2(j47Rpb*n=oπU"V;+(=8^nB/.lf&gpOxII;n;^J&0_lCJkCF3/K^+aWUgp(I>>HEFu^Hp6ft%5W#\πU"w*z<P7c5A_N>T(&)yt7\e\+c/Ta8uIYUeLxUJ&:(3aTnc&wk_f):3=hb&JN7(nVπU"*kzy#L#['UT/E729xxJ$_utX3GQ+SK;6+c3/p'[S]wRTdI::;q$T]jZsH##Z_v:πU"$g[VRW0o0S(#Q(Zcqu6M855u5l(7P^r-Ji+Re2=;>&hOtFm0_%i](;1bP'=n70tπU"i&wdNK-haNN))+.hDYP6cN^uhRU$QBm.At)wbLZ-bL-uc'Hy;(3iowDzFQ,(IGIπU"8'%BadUjY8L<'cp90c/A^l,Oo;kd0N93-640<YM[qg.KBA%b3b[5.HTCuQlITs.πU"QId5S4iq=Lfb'rfk;wj_e#(*4n5<;_cE&YI[_C.4[s$HneVjIsbkj:l33^<BFDnπU"Ec=m?%;4LmSV6.RJ*W5b922'BQFZ^q]w63,0M6/RlrNrVOOk(j(qf-jFSTPATRbπU"RRU3n:PdOp,osU\+tTHtjVlDw?RHxxSJCN1:vD5tl/3>$+;V(M5sht1g$W$K3f.πU"p2\nSn(Fp[x-;LkM(qFb%>]?pUief5cx$L<RdQdYw),DhDQl6,lkd#Y1(fx3IFVπU"9[^\wuVLYx<5Y1ui]U750L5#:2E=D:1HUlIglj^cvT8NgLOZgeWl4>?(0F\idF\πU"ZG:Hh75:pdPS4Q52&mcDUxmPq6&ml<Wr6Ij>M1D%B'Vp,J+nq&m<sspjO^(L5eLπU"5?iMtWoTCBBqg.45WaCJS8w#wLaV2cLuYg_7ItcJJdLHX7+#tk_m+AqKRi/tq1rπU"Y91N7.mSoN_?4&&YCiOhyK'ECZ49IVFCJ+>REXlQ6yI%Nf&=M9d7N;d$&_zgxsRπU"IF'QTsXl'55hgX:X;.$MI+r8i#z4Af&(%mMRA0aM*m'mfhTG1pdXA4^C.7[Lo\[πU"Fbp#hi0q/mpsU-H\Q6YaJ=QRN[&2pF.r,ivX3B9a-r^ZOW#f3Y]r+=[2<hmI,>#πU"ioj,zrU,<39HN8=$lpY^[6Qst;2hCkV_GX=\;[E+y:p/_gkau/RJHp,>tf,ZOE_πU",VLCVqjW(*b)+HcgN.$N,^CQkbwSQnTnr;fKR+z1>g>vE^k]D*F\T]M,kNN$Pg9πU"W9/ybP,Ur[5ENE52o+hfh:WF[#Pl.Hc&J2oant+[2[e.fz;B$T+^'#k8;>End7MπU"e%p%85xP<K:z4ae(C4;camGf#Xo<8Nl2/^FB\vP%ha41d=Xe>31$5u0G5zvDASbπU"uO1.j&m(FOGpFJv/S$kUB54&K>>Z7$01:_8Ipc*<\-jRwC)d^A$YXFD2s+v26JdπU"1<jcSUOtcRWWF?gjo;q*-PXTJD1-r%LQW'[pyQ$[:muW.h\<E]DOfF8vr+kAcLgπU"-OkcjsA_$Pl:AFgEQP$G>.:#6U0WhJ]wS1um*d$?\\<3vq>LH\sLUJIZG$(LC*5πU"add*aD?;82cv0%c_,IL-R,3Ibj*I=Ci_3blWs;klMXtaf;U>D?=2Yl(u'\nV1gDπU"KErKO1x(RHwd7dtm#x5<J7gx1f_Y]i+uLWlP&z'pCDroheCa3$6TC+sef[RqG3qπU"fDB7#cUqXn&K&/ZAO:-p%Q_TXh4:SMm]TQ9I$V0)'=LY3$l_9Uwn^&wf'-2BobJπU"N=LatJ37u=xMDE^l7^4<MBUTnWprCOK_v.w_7>5VT*4'Ueu7*WOD\Pp6J0p#hVDπU"nlQJ?HKokk\YTqMgxBATYB<pA#)\k'H\[VN93VAht'Iui>8FdtD:MEd26PBVMSqπU"u^>ou$v;*PU,u88?xE49P_64wv\0MLyR#(Q3Z6%mgTawQMmI5jhEdECACCz'MV8πU"s9-SGQAHaN)a4RI63MG?Gm9Gt&jQPRBK19Iz3sq1=R4e;3YsdoS(5eMQRJsVZ2/πU"aR8k^V\7u[-=W)T,Iw2APE.%Y3l#<IHe;#R%5UW5YaixT#0Jj#VN/eIrWA<*AE\πU"g;.1K#P\l985ph4#2HgRa_+:]8DZ-d+vM[E<RfppHN#t60pK^Y%8O>P;M;Z0cdRπU"Pz7$i3;0pN$aHxYfdW8+)&igsE<78:.>f<zK$y3_osDUj*at4nScyeGo2k:?8i'πU"g9>X2U-13n1)]ngH)-M\&\Ip[);#[CaM:I'ZGYN5p&s/68+5pp>UBAR\Qfsx[YGπU"oI-U2Y$/L7>.m:jkisj$Yxsl*#^2$VT2<aanZV<*WAx]_GkN)/t5.OfA\I^<6D+πU"4UtF'xS;a/Bdyr24Cae6nj3B:EX-u<AHiv1G_<>^umf;774Aw,;_MN^un0;wVkAπU"qr5,EodQMPNn&9Hwq4F/vQ<;_m%/U?)WqtuIJka;Rs'jB%9*l(Iz+5T15Tg]7+LπU"^Q(E2Zo'5Xt<_T%;0orkh:'87KJ?uik>-U6T_#&0H-rk:q'=7JO__j>*.e2Pki&πU"2AVY5d'<,qR_(Kl[8*f)^ABl(TzQRPDR6j==xmL6,6IMYUFU.'uhaBop,XzLegTπU"vMO[KJbkl9oU3<K0(:oNpaOEgY&#M74'GMk-p_?[-HQ5=c?K7Z)eZi1f3?vLsrMπU"y:m2ED[TpGer>jPEV(0:K>.DfuMFY52i%c2ifkv,jN3H2%1/gG)DHL*H3>ArKRQπU"\]DZp_]Vhzt.F.iC7.aP*J?3/sEBO;g]+J6tCSU=>eqCzk\qZR_P6\MY<>x4mπU"Er<JS.)P0+EjgLbo].iT=T8u+A:c9%Q;untp41wH\it+lu(8w+E[(2$LcNgmbpbπU"8Ebq]lxNeeOwC$S=G[\\x;=XhiaGxM3%idH4(Fa3,8cJXBC#P$>AmhZHa7<\7\/πU"6ndxcH#yT8DUl17aJc-XXsS2jUxMSE9jP/:0H'^'EQnuH>$O<cYRZD<.cJcOBl9πU"<fmb>?^8E\<3U3&\Ja8FOVl^HP6r^\#JjaY#i\hmFum5B,E*m\HQ-XBUJdTg?O_πU"JHIOw2.TGR6q4Cbxbq(RbjeVK4\6HICNE^imEYid80xVa%B:\Z_Jt#cF$s:ML_rπU"6pGg-Gkhp/f&);[]Uq))8RO5p1-(n6<Vlleeu^Kh539%/C=092=b2^xbI.t7ej<πU"v(sk2-4NV=>8Nw9k:X#Xt'MiRZGcQAA&?xL?5fX=1p&8GA-^?>LiW0gB)\C(/j+πU"v-aiAuW?\gVO2pk#[?SfH7;fIMVbWAb-P4N_QS<'pSyLi0y=_mc^^n(Wbd<+pqVπU"c#Nrj]5NBx6624(w*eteBYyO.rY+l5Q9]XRmM,:t-O-+ls-2W*G>%wMGZCp_B,&πU"$/T(sm$xl;EUBfwtetJfF^9)2-NYn2SDT*_+Zzi(cB'CO=NZMTJ?heAZKo([kyNπU"2-WbON=</A2DBlp8mGu?&FaHb%PG8wAtGip<K'+lNG.l%;*3GSP^.npGS$P;bf5πU"M<M*euQi:cA20uX7bi[^?V1b%+fS]\BAB:gM_''<o3WA=Sy1qcH0NH<ka0j/Rr]πU"(G9U-lFq$\8SmgTTARH5wD^Y%[-GVVB0V$QUwYef\n8]>ORa'q:X6I_\^\R:pI'πU"zZ$\v5I6RXnb+oT8$DQ/b6RZ3n7Y+$;Y0kY&OhN86kUs=vX-N3F[1HPsJzlNV_qπU"qitM6'2pF_3FSPRCY:li[+OV<n6e&ql1<HWYzvc1i&LBI/7/Mg_+OD4HYxGk.gWπU"/qqPY7vn)9,Mt]L1,Z)fO*QlG02crKO/B)cbZrNEWAX.1jRPY.;m%%<eu:L2t%mπU"n-bq8U&L1f:4N1m%U[ThPrJKk8YV37PW%_P\5(vC5>6>RjrEW,[>+4r^.U0JLnuπU".66U+1'5g,bg5/=mY]9EiBymZ$PYckL;z=I;[4-b'H;?Q00(Z5A-);7/OUo;a:TπU"1#n'LcOy1bXR<2\XNcGJZl(=2Cp,4r9,eOOst:T$iM_KuVUt[jdg8d0_XE=4uT1πU"Wa5eE%a^[.T:JLVSmeEHT>FOLe:.LNJddKezmRjb6_6;LP6j:kHjJ<G1g)JWL?6πU"19AFE;#F;cSWK*&k(B-^6Be(^ToiH&q-RRu2bGup*3mt+$G[itBwtxJj7x2tKxfπU"x>2kd'K_EXFQ:&U1'rEjQh+B/)7&1)>Q&t)/T\6NOd(q0yQPj^&Wj5*[*5?jI$iπU"FwKWK)s=:Nn[pl#07?EGqclv,m*Ua$t%pb%bqn=d7D2o44^2qU]r.c1maA;B6W7πU"a*6Y^$+=rt[4kb-Q]0,ok(#H\LE$xmpa/SS8AL<rEM''U^GGF'D8G[8hrZtn0f%πU"p$RM'l1zSA6x6-B$fv=P49X3B;F&i03P2h3SLp2UnIVn_i=eBGT;[e<rGwTruQeπU"$=#6]anK/d2>$([2h?Z_s*J1/l0k$=?L-P/r%(Gu7pXgw[2G9dLmd=T5c7W]PQ?πU"E9N*^^uDE)AS8+7?n8tn\]Ghir$X510c[x;XB)YhYj1zQ1[IZVjcH1:+&&/J<+#πU"vjdqfN89jdVf^eTKqeV(q_fmrPN2BS=&x$;]ar4Fe%#0;eq)a#QVc+0d0[6Zit.πU"1oP6i:J)DYZ,Od#)9'UP]FIwP<YlqMNdRB7\_2Rx2tzKJv>b'p)^fmX<Um%eTW$πU"\Z.cWnPqnQ.]at,\]dlX(o^NVRL\=N0J<i(<gQrwgqqrNS8k9WmtFQ6/[bIi5jBπU"_ihawt$Em;qahk0cK#d+Dc-qeMaqFNSsD6g]mHjhHwAPI)0Hjp<,Uw4%up()%9%πU"'%#-%L4[1FVa3ok5&7%%3*%%%7%%%%rf&)jxT%ijrt.rf)j%SrruS,yD$\2V-5-πU"4C^]2Thibmq%qAaAseubp%DINII4*^7.ZIukdtXQdrGLNv-:lkBvJ8CTDOMIc0mπU"^G_(oE2XzIcb%JLDTqV:^^AMB6&40T,gt6zFsXG5v5Al_)2LWAb4BDpX1>5R8;&πU"jG_$ErWJ?<>*h(Ls5:\QROnEJ=<WEu<+2,B/t[6^MU.%p(S:>4/E\Ox/f?\%kq8πU"*cO7csK#U^JR/u2oj+Xi=ULUagfPB+ICHZqK'tL##kzPLGan'1ing5<n(M$QX5:πU"egT/q7?Jdf)1]DFh4h0M2;>l]%XELh1]dE,ppXJ0Pr0-jaCV\liS(6b8y7hDT5MπU"qR8UO9.StYxYBtjcFP[pn0g=dsLz4i8:lUU31iSlFFuhJ8Mfs:V-5.\2_-;1l7LπU"]XD/IY%a_'hL8Z.;XtC<i>g[/ZjGaHm?'v%NLN<=;<sM]4#zd;Ic+<iK'x,up%(πU")9%%'%-%)aS1FLsxl7&9&%%'3*%%%7%%%.rf)j%xTij.rt.y&&tSr.ru4y:f=<UπU"a14,AODsS=K93JO,J]3acavtRh3XaU;px\M#;rwALCn.^NtIKK9t=lb6w5-CrWPπU"$XoYdL.f%'Dl8?agnY+eTLe0T1'dlKHM]xPh)DB1m'5iYL3OJh4\&w,P%+L45IMπU"W1[o.+fUW)IaJLif1RdY9_MKp%21m/=9AMnT$3b4VqOnQLr1)=$(Yv:MJfFtUOaπU"fHBTJJgb(oa2Sre1;\,5KAU(u-/>V$'/P^_0C):<egDAL-1m[Zu'xAIVBM:He%fπU"VwzArzTqS0IKsI6O3Zp/kZ6$*YD2V\TcJF1pICe/9(X]POn09+$,<B3Ii0rMX+JπU"do_#Z,.;Uv6RN0fJ(Dw,^1UkGJ)Mw_F[Ya%(L6RA/C'27diRy$ZONfErk#iR\$_πU"]*=cxTi>q*IR=[sEbnaC>QsTlF8*HfZ3<#V)=g)sdM7_k\UaC#L8DO2Hj8T[.NXπU"Y2(.%up()%9%'%I-%zU#1FPa*'qO(%%%U3%%%5%%%%rf&)jxT%ijrt&.XSrIru<πU"&:n]]U+14\u_NwLE/QC/C/ocA3=aavtZb+&T&A25y.ws1p[Ij^HOd8n^t^$H8utπU"p#suvnrsuvpn.X+O^BA\ccK^DKB$NCK\mW,lDBqrVp\u'pUk97c4L8',p#d;8)wπU"5ztLTZO^tGfE/^pD-fPY%-A6lF+_]29=nH6a\OpaLE#5YF*);V4An)aY2t5QC_vπU"Zj2S66fr4BEblGKQ%81+Oz11B.WkrV0\Viz<Vu]J*[<]7;-IW.;kP&=:<I/d6QmπU"ZJH8Z9jE,baj_QTEha7&+/i[$%e1>2tu569p3GI5+edHHXK1ieZstMb%-Nb[h,hπU"F79FBx#9'y[_HU\)Y6Jx7IBKSCduyx0_S;u_(GU+Q/04+?-W:(g-VBRaAn\fMuXπU"\M(0a^rV^6Ja.9iO+'u;'K]2t4m*5s>Yx##yD8qYgB=;27eh.Mq?hN0aPW84(MQπU"*)6?LS4(0M+T24$T=z'):R_pGS[0W(2ppPJhKCL+4:?\H#?t81l=\obg9oT$4e,πU"DXao52P?L#KDUqaYOKFG?sSp2dr/Gbrt.MI741P&>t.QmHgC:Le).xxu:K]qpTUπU"ClNw*G/I*j[9<p=/$m4LoUCDSiv#,W+kK$HIZ>F+jWT<#b>X6>rmM3%wJa.&W.6πU"[^=0[XbqEW3u4BW>c[B6^)xsn\:2kwo4zS-?kB\O%129jjU+Kn3NoGQ/3+A<<0CπU"8:w1Dt,0,EJukVYYl-Ko=%LU[UM\+qwfv+v3DyrUT[SD#o26PC*$O/pra*hK%EDπU"IL><_NbrD\&MU[SIHTeroHrN&q^9w[:(xmWC4%NfEizR?YWbW8tdFq.+:)v'pKbπU"qQ_wqY^51[_[rd)%k#%P_rJwkc--khyNar(\KFStVY1+K;$D:-#mbs/b4e_;lO9πU"$M)-pL-+JsE<J-)utsxQEa)$BfaMl-G3FX-EJUqd1'%T6oiqNrTAhCo8zgMP0v/πU"023[aD;6W[dtq%a0Q%4hw5;U//_,LKVb;A\PBuGu%gv5Ef,]eOjGJ03N;Faw1.^πU"QK(%up&'%9%9%%%%%%(wS1F%%%%%%%%%%%%%%%%+%%%%%%%%%&%U%%%%%%%%%rfπU"&)jxT%up&'%9%/%%%%%%)zU1F'XT9L%F%%%%F%%%%0%%%%%%%%%&%E%%%%I%%%%πU"hf%yfqt%lSrr%uup&%'9%9%%'%-.%3Y1+F6kc&[>%%%%M%%%%/%%%%%%%%%&%E#πU"%%%=%%%%v%rruw%tShk%lup&%'9%9%%'%-.%yY1CFq3N%Z.7%1%j3%%%/%%%%%%πU"%%%&%E[%%%(%%%%v%rruw%tSgf%xup&%'9%9%%'%-.%L41mFVao)k5&%+%3*%%%πU"7%%%%%%%%%&%E[%%%Y%7%%r(f)jx%Tijr#trf)%jSrr%uup&%'9%9%%'%-1%aS1πU"IFsxl)79&%+%3*%%%7%%%%%%%%%&%E#%%%E%9%%r(f)jx%TijrCt.y&%tSrr%uuπU"p&%'9%9%%'%-1%zU1dFPa'&qO(%%%U3%%%5%%%%%%%%%&%E%%%%5%;%%r(f)jx%πU"Tijr(t.XS%rruu%p*+%%%%%,#%,%j#&%%7%>%%%%%πEND SUBπCLOSE:IF S=37AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπDon Schullian/Jim Oliver       DRAW A CADIOID (DAISY)         [e-mail]                     08-30-96 (10:20)       QB, QBasic, PDS        156  6160     CARDIOID.BAS'Here's one for you that Jim and I got together on. It's kinda fun.π'Ok, this is it! No more beta versions of this thing! I'm DONE!π'Unless, of course, someone comes up with some improvements. :)ππ'The code below runs under Qbasic but is slower than growingπ'rocks so you may want to just draw one daisy and leave it at that.ππ'Those of you with PowerBASIC will want to add BYVAL andπ'LOCAL PUBLIC to the sub's declare line then tweek it all a bitπ'to get it back into fighting posture; if you decide to keep it.ππ'Anyhow, thanks for the great idea. I'm putting this one in theπ'box with my polygon routines for later. It may just come in handy.ππ'This, the final version will correctly draw Cadioid Curves (daisies)π'  **  of any number from 1 up to ???π'  **  uses the "ASPECT" variable like CIRCLEπ'  **  will draw the curves at any degree of rotationππ'One of the demo's (RollingWheel) draws a wheel as it rolls up offπ'the screen. CanioidCurves is used to draw in the spokes and ASPECTπ'is imployed to provide perspective.ππ'The other demo routine, (Daisies) draws 20 daisies on the screen thenπ'rotates them clockwize until the next lobe/petal/loop comes up to theπ'12o'clock position.ππ'Both these are pretty crude and intended to show the use of the mainπ'routine. In short, Speilberg and Lucas can rest easy for a while yet.ππ'It may be worthy to mention here that this routine uses DEGREES ofπ'the circle and not RADIANS. I find it easier to work/think inπ'DEGREES so that's the way I made it.ππ'You will also want to play with the Aspect! variable. Try numbersπ'between .5 and 1.6 for some neat effects with screen 12 or .75 toπ'get round circles with SCREEN 9.ππ'Anyhow, this one goes into the PUBLIC DOMAIN so have at it!ππ'=================π' START TEST CODEπ'=================πSCREEN 12πRollingWheelπDaisiesππ'============================================================π'===  THIS CODE IS RELEASED INTO THE PUBLIC DOMAINπ'===  USE AT YOUR OWN RISK and all that legal rottπ'============================================================π' CONCEPT: Jim Oliver        [e-mail]π'CODED BY: Don Schullian, DASoft Software, [e-mail]π'CODED IN: The code is pretty well generic but may requireπ'          some small changes to run.π' PURPOSE: Draw a cadioid (daisy) to the graphics screen (12)π'  PARAMS: Col%    center column (pixel)π'          Row%    center row    (pixel)π'          Radius% radius in pixelsπ'          Asp!    aspect ratio  1 = normal for VGAπ'          StartD! starting degree for "top" lobeπ'                  0 is 12o'clock, 90 is 3o'clock, etcπ'          Lobes%  number of lobes/loops/petalsπ'          Colour% color to draw inπ'============================================================πSUB CadioidCurves (Col%, Row%, Radius%, Asp!, StartD!, Lobes%, Colour%)ππ  IF (Lobes% MOD 2) = 1 THEN              ' an odd number of lobesπ      Petals% = Lobes%                    'π      T% = 1                              '  stop after 1st passπ    ELSE                                  ' even number of lobesπ      IF (Lobes% MOD 4) = 0 THEN T% = 2   '  only 1 pass requiredπ      Petals% = (Lobes% / 2)              '  decrease # lobesπ  END IF                                  'π  Pi2! = (8 * ATN(1))                     ' pi * 2π  Srad! = StartD! - (90 \ Petals%) - 90   ' adjust to find topπ  XRad! = Radius%                         ' horizontal radiusπ  YRad! = Radius%                         ' vertical radiusπ  IF Asp! > 1 THEN                        ' aspect = 1 for VGA is normalπ      XRad! = Radius% / Asp!              '   squish verticallyπ    ELSEIF Asp! < 1 THEN                  'π      YRad! = Radius% * Asp!              '   squish horizontallyπ  END IF                                  'π                                          'π  DO                                      'π    IF T% = 1 THEN                        ' compute starting degreeπ      Srad! = Srad! + (180 \ Petals%)     'π    END IF                                'π    Sr! = Srad! * (Pi2! / 360)            ' compute radians for degreesπ    PSET (Col%, Row%), Colour%            ' center dot - sets LPRπ    FOR T! = .01 TO Pi2! STEP .01         ' start drawingπ      L! = SIN(Petals% * T!)              '  compute factors toπ      P! = T! - Sr!                       '  use to compute X and Yπ      R! = XRad! * L!                     '  general purpose radiusπ      X% = Col% + (R! * COS(P!))          '  compute column for pixelπ      IF Asp! <> 1 THEN R! = YRad! * L!   '  if aspect other than normalπ      Y% = Row% - (R! * SIN(P!))          '  compute row for pixelπ      LINE -(X%, Y%), Colour%             ' draw line from LPR to new XYπ    NEXT                                  'π    T% = T% + 1                           ' increase pass counterπ  LOOP UNTIL (T% > 1)                     ' all done!ππEND SUBππ' ------------------π' ---  DEMO SUBS ---π' ------------------ππSUB Daisiesππ  CLSπ  Col% = 50π  Row% = 50π  Rad% = 50π  Aspect! = 1!π  Colour% = 14ππ  FOR Lobes% = 20 TO 1 STEP -1π    I% = (360 \ Lobes%)π    FOR StartD! = 0 TO I%π      CadioidCurves Col%, Row%, Rad%, Aspect!, StartD!, Lobes%, Colour%π      IF StartD! = 0 AND C% > 0 THEN SLEEP .5π      IF StartD! = I% THEN EXIT FORπ      G$ = INKEY$: IF LEN(G$) > 0 THEN EXIT SUBπ      LINE (Col% - Rad%, Row% - Rad%)-(Col% + Rad%, Row% + Rad%), 0, BFπ    NEXTπ    Col% = Col% + 110π    IF Col% > 580 THENπ      Row% = Row% + 110π      Col% = 50π    END IFπ  NEXTπEND SUBππSUB RollingWheelππ  CLSπ  Row% = 400π  Rad% = 40π  Aspect! = 1.2π  StartD! = 0π  Lobes% = 11π  Colour% = 15ππ  Col% = Rad%π  Sincr! = (360 \ Lobes%)π  DOπ    CIRCLE (Col%, Row%), Rad%, Colour%, , , Aspect!π    CadioidCurves Col%, Row%, Rad%, Aspect!, StartD!, Lobes%, Colour%π    G$ = INKEY$: IF LEN(G$) > 0 THEN EXIT SUBπ    Col% = Col% + 1π    Row% = Row% - 1π    StartD! = StartD! - Sincr!π    LINE (Col% - Rad% - 2, Row% - Rad% - 2)-(Col% + Rad% + 2, Row% + Rad% + 2), 0, BFπ  LOOP UNTIL (Col% > 639) OR (Row% < Rad%)πEND SUBπScott Turchin                  GET BACK TO ROOT DIRECTORY     [e-mail]            07-24-96 (11:26)       QB, QBasic, PDS        15   476      GETBACK.BAS I once needed a simple but effective way to return to my programs root πdirectory each time I returned from a shell, rather than type it out πeach and every time (there are 4 shells in my program) I made this happy πlittle subroutine...However, Somewhere in the beginning of the program πthis must be performed:πHere$=CurdirπDrive$=LEFT$(CURDIR,1)πππSUB GETBACK( HERE$, DRIVE$ ) PUBLICπ  CHDRIVE DRIVE$π  CHDIR HERE$πEND SUBππVery Very simple, but effective...πGeorge Phillips                FORMAT OF GRASP ANIMATION FILE [e-mail]             03-15-91 (04:16)       Text                   816  29501    GLFORMAT.TXTNote that some of this information is incomplete.  Check the Graspπmanual for clarification on e.g. the script-file commands.  If πanybody would like to merge all relevant documents together, thatπwould be nice.ππThese documents were passed to me by Martin Fong, [e-mail]ππEli Brandt   [e-mail]  32@4351 WWIVπ========================================================================ππThe formats of GRASP animation files.πBy George Phillips <[e-mail]>πDistribute this freely, but give credit where credit is due, eh?πVersion: Jan. 19,1991ππGRASP is an animation system particular to the IBM PC world.  It consistsπof a program to create animations and a run-time environment forπdisplaying them.  The most common form these animations take is ".GL"πarchives which may be displayed on an IBM-PC with a program calledπGRASPRT.EXE.  This document describes what I have been able toπdecipher about the format of ".GL" archives and the files containedπwithin.  It should be useful to those attempting to write ".GL"πanimation players on other platforms.ππA ".GL" file is simply an archive file which contains images, fontsπand a command file which tells GRASPRT what to do.  These variousπfiles have standard extensions to denote their contents:ππ.txt - A command file; usually there is only one of these per archive.π.pic - An image.π.clp - An image but without a colour map.π.set or .fnt - A font containing character glyphs.ππIt should be noted that the GL archive is of no particular importance;πall the archived files could exist as ordinary files and the animationπshould still work.  Any GL player should be able to operate both fromπan archive or from ordinary files.πππFile FormatsππMost of the data in GL files can be adequately described as a streamπof bytes which is practically universally understood.  Some fieldsπcontain 2-byte and 4-byte integers.  I'll refer to these as "words"πand "long words" and they are all stored in little-endian format.πSo if we have 4 consecutive bytes, b1, b2, b3 and b4, the wordπat b1 is (b1 + b2 * 256) and the long word at b1 isπ(b1 + b2 * 256 + b3 * 256 * 256 + b4 * 256 * 256 * 256).ππSince this information was gathered by example, the purpose of someπheader fields and commands may not be known.  I've marked unknownπfields with question marks and have tried to put question marks andπother warnings about descriptions which are guesses.πππGL Archives (.gl)ππA GL archive begins with a directory listing the files in the archiveπwhich is followed by the data for each file.ππ+-- Directory Headerπ| dir length    (word)        number of bytes in the directory headerπ| +-- File Entry (17 bytes per, (dir length) / 17 of them)π| | offset    (long word)    Position of file data as an offset fromπ| |                the beginning of the archiveπ| | name    (13 bytes)    File name, null padded.π| +--π+--- File data areaπ| +-- File Dataπ| | length    (long word)    Size of the fileπ| | data    (bytes)        the file's data (surprise!)π| +--π+---ππFont Files (.fnt or .set)ππThese are very simple; first a short header describing the size of theπcharacters in the font and what byte values correspond to each glyphπfollowed by the glyph data.ππ+-- Font Headerπ| length    (word)        length of the entire font fileπ| size        (byte)        number of glyphs in the font fileπ| first        (byte)        byte value represented by the first glyphπ| width        (byte)        width of each glyph in pixelsπ| height    (byte)        height of each glyph in pixelsπ| glyphsize    (byte)        number of bytes to encode each glyphπ+-- Glyph Dataπ| glyph firstπ| glyph first + 1π| ...π| glyph first + size - 2π| glyph first + size - 1π+--ππEach glyph is stored almost exactly as you would expect a raw PBM file toπcontain it except that a '0' bit means black and a '1' bit means white.πIn other words, row major order, each line padded to end on a byteπboundary, most significant bit is leftmost.πππImage Formats (.pic and .clp)ππThese consist of a header containing the usual image information followedπby blocked, run-length encoded image data.ππ+-- Image Header (17 or 19 bytes)π| magic?    (byte)        magic number?  Always is 0x34 or 0x12π| width        (word)        width of image in pixelsπ| height    (word)        heigh of image in pixelsπ| ????        (4 bytes)    unknownπ| bpp        (byte)        bits per pixel (only seen 1 or 8)π| type        (byte)        image type, either 'L' or 'C'π| flags        (byte)        if (flags & 4) then image has colourmapπ| ?        (byte)        unknownπ| extend    (byte)        extended header byte (if != 0, headerπ|                has 2 more bytes) 1/2?π| ?        (byte)        unknownπ| ??        (2 bytes)    header extension if extend != 0π+-- Colour Map ((1 << bpp) * 3 bytes, only if flags & 4 == 4)π| +-- Colour Map entries (as many as indicated by bpp)π| | R        (byte)        red intensity, 0 - 63   \π| | G        (byte)        green intensity, 0 - 63  + entry 0π| | B        (byte)        blue intensity, 0 - 63  /π| +--π| ...π+-- Image Dataπ| blocks    (word)        number of blocks of dataπ| +-- Data Block (blocks of them)π| | length    (word)        length of data block, including headerπ| | bufsize    (word)        buffer size needed to hold all theπ| |                uncompressed data in this blockπ| | esc        (byte)        the escape code in this blockπ| | data    (length - 5 byte)    run-length encoded dataπ| +--π+--ππThe run-length encoding is byte oriented and follows these rules:ππ- characters other than "esc" (see data block header) are literalπ- esc n c means repeat c n times (1 <= n <= 255)π- esc 0 len(word) c means repeat c len timesππIf bpp=1, then the resulting data stream is interpreted as it isπwith font glyphs (i.e., msb is left, pad to bytes, row first, etc).πIf bpp=8, then each byte in the data stream is an index into theπcolour map.  If no colour map is available, the map to use canπonly be discovered by running through the command file.ππI've only seen images with bpp=1 and bpp=8 and they it always worksπout that either bpp=1 and type=C or bpp=8 and type=L.  The type=Cπcorresponds to CGA graphics which are mostly monochrome and 640 x 200π(so the aspect ratio is funny).  Type=L is colour graphics, prob. VGAπand usually 320 x 200.  Notice that the colour maps have only 6πbits, the same as VGA's digital to analog converters.  ".pic" filesπalways have colour maps, ".clp" files never do.  It seems thatπyou can be lazy with your run-length decoding code; I've never seenπa full sequence appear across a data-block boundary (encoders shouldπprobably not let that happen).  The amount of uncompressed dataπin a block never seems to exceed 8192 bytes.ππMuch of the header information is mysterious.  Note that the headerπextension field is a guess and that there are other consistentπpossibilities (e.g., the extension field is a length byte or evenπpart of a length word).  Only type=C images seem to have theπextension.  Maybe the extra information is supposed to be usedπin video mode operating system calls on the PC?ππWhat made this part easier was the existence of a PC-based program whichπconverts ".pic" files into GIF files.  Its called "cvt2gif" and canπbe found on wuarchive.wustl.edu:/mirrors/msdos/gif/cvt2gif.zip.  Thoseπwishing to enhance the format descriptions would do well to get aπcopy.  I did notice that bpp=1 images are not necessarily black and whiteπbut could be black and some other colour as selected from the CGAπpallette.  I doubt the distinction will make much difference to theπanimation, but if you really want to do it right...πππCommand File (.txt)ππThe command file looks like a typical script file with the lines delimitedπby carriage returns, line feeds or both.  Any text following ';' on a lineπis a comment.  Text followed by a colon is used to indicate a labelπ(much like most assemblers).  Commands consist of a keyword followed by aπlist of comma separated arguments.  The input is case-insensitive exceptπfor arguments containing text to display (which are in double quotes).ππThe basis of the command language seems to be what I call picture andπclip registers, of which there are 16 of each.  A few commands willπload a picture (or clip) from a file into a register.  Other commandsπthen reference the register numbers to display the pictures or getπcolour maps from them.  It seems that the colour map from a pictureπ(.pic) is installed into the hardware and this is where theπcolour maps for the clips (.clp) come from.  I assume that I am missingπa lot of commands, but most notably I believe there should beπmore primitive drawing commands.ππMany of the commands seem to have a delay argument associated withπthem.  This seems reasonable as control over time in an animationπis important.  I may have been over-zealous in looking for delays.πThe actual time units of the delays is unknown.  They are typicallyπnumbers < 100, so milliseconds are a likely candidate.  Hundredthsπof a second are possible as well.ππHere is a list of commands.  Optional arguments are enclosed in [].πRanges are possible in arguments (I've only seem them in fly) andπtake the form "n,-,m", (e.g., fly 0,0,10,10,1,1,1,-,16).ππ* box x1,y1,x2,y2,colour?πDraw a box with corners (x1, y1) and (x2, y2) in the colour given byπthe colourmap entry number.ππ* cfade x,y,delay,img,[,?,?]πDisplay a clip image img at (x, y) and wait for delay time units beforeπproceeding.ππ* cfree nπFree up any memory associated with clip register n.ππ* clearscrπClear the display (to the currently selected colour or black?).ππ* cload name,num[,?]πLoad a clip image "name" into clip register num.  If name does notπhave a .clp extension, it will be automatically appended.ππ* color nπSet the current colour to n.  This at least seems to affect theπtext displaying commands.ππ* exitπTerminate the command file.ππ* fload nameπLoad the named font which becomes the font to be used when displayingπtext.  ".fnt" is appended to name if necessary.ππ* float x1,y1,x2,y2,step?,delay?,numπMove the clip image (num) by displaying it at (x1,y1) and erasing itπand displaying it every step pixels until (x2,y2).  Delay delay timeπunits in between steps.  Or maybe something completely different,πbut the x1,y1,x2,y2 and num arguments are probably coordinates andπa clip number.ππ* fly x1,y1,x2,y2,step?,delay?,clip listπSuccessively display the clip images from (x1,y1) to (x2,y2) with delayπtime units in-between.  The clip list is just a bunch of clip numbersπseparated by commas (i.e., fly is varags).  A range is likely toπappear in the clip list.  Often (x1,y1) == (x2,y2).ππ* fstyle ?[,?]πPresumably set up some parameters on how a font is displayed.ππ* goto labelπForce flow of control to the given label.ππ* loopπDenotes the end of a mark loop.  Continues the loop at the most recentπmark if the loop hasn't finished.  ππ* mark nπThis pairs with the loop command and begins a for loop from 1 to n.πOne assumes that the interaction of mark, loop and goto is the sameπas for, next and goto in BASIC.  That is, loops are dynamicallyπscoped and you can jump in and out of them.  Mark simply pushesπa loop start onto the stack and loop examines whatever is onπthe top of the loop stack.ππ* mode ?πModify the current video mode in some way.  I haven't seen this often.ππ* note freq,delay?,durationππPlay a musical note of the given frequency and duration and delay forπdelay time units afterward.ππ* pallette nπMake the colour map from picture register n be the one to use.  This probablyπinstalls it into the hardware so that when a clip is loaded there isπno colour map to change.ππ* pfade effect,pict[,delay?[,?,?]]πDisplay the picture numbered pict on the screen.  The effect numberπindicates what sort of special effect is used to display it.  Whatπthe numbers mean I have no idea, but I know some of the effects.πEach pixel loaded randomly, every even line then every odd lineπand so on.  The delay parameter seems to make sense, but not always.πThe extra parameters could be those needed for some effects.  Oftenπthey are large numbers.ππ* pfree nπFree up any memory associated with picture register n.ππ* pload name,nπLoad picture "name" into picture register n.  ".pic" is appended toπname if necessary.ππ* putup x,y,nπDisplay clip register n at (x,y).ππ* set retrace [on|off]πSet is probably a general internal control variable changing command.πWhat retrace is I have no idea, but it was set off then on aroundπa fly statement.ππ* spread ?,?πWho knows, but the numbers used are probably picture register numbers.πMaybe some kind of colourmap changing?ππ* text x,y,"text",[delay?]πDisplay the given text (enclosed in double quotes) at (x,y).  Theπextra parameter is probably a display, but it could be the displayπcolour or the background colour.  Probably the display colour isπthat given by the color statement.ππ* tran [on 0|off]πNo idea.  Was used around some cload and float statements.ππ* video modeπSet the display mode to 'C' or 'L' (remember the image format types?).πUsually the first statement in a command file.  C almost certainlyπrefers to CGA which is 640 x 200 monochrome and L almost certainlyπto VGA which (in their case) is 320 x 200 x 256.ππ* waitkey [[delay[,label]]πWait up to delay units for the user to press a key (or forever if noπdelay time is given).  If the user presses a key and the labelπargument is present, transfer control to that label.ππ* window x1,y1,x2,y2,?πSome kind of display control.  Probably a clipping window with appropriateπcoordinate translation (i.e., (0,0) becomes (x1,y1)).ππππThis document was created by looking hard at a number of GL files,πusing cvt2gif to help decipher the image file format and lookingπat 1 or 2 animations on an RS-6000 running a PC emulator and usingπgrasprt.  cvt2gif was very useful; grasprt under the PC emulatorπwas painfully slow at times and didn't help my understandingπmuch.  I've never even gotten close to a copy of the program forπcreating and editing GL files.ππIf you find out more about GL files, send me the changes so I canπextend this document.  Feel free to include this as supplementary πdocumentation if you write a GL player.  Finally, here are someπprojects which could help find out more about GL files:ππ- Get cvt2gif and feed it small variations on .pic files to decipherπthe meaning of the missing header fields.  I may do this.ππ- Alter control files on some animations and see what effects theyπhave.  Something easy would be to change the effect number onπpfade statements (if that's what it is).  I don't have the hardwareπto do this.ππ- Look at the GRASP animation package and intuit what the commandsπmean by what control you have over generating animations.  This isπprobably the easiest way to get information.  I don't have GRASP,πI don't know where to get it and I don't has a PC good enough toπrun it on.ππ========================================================================ππGRASP/Pictor Font format description                                  09/06/87π------------------------------------                                  --------ππFor convenience, we have chosen to adopt the IBM ROM font format for data, butπto keep things manageable, we have added a 7 byte header which describes theπfont.ππThe seven byte header is defined as follows:ππWORD    number of bytes in character data, plus this 7 byte header.πBYTE    number of characters in set. 1-255 or 0 if 256.πBYTE    ascii value of first character.πBYTE    x size of character in pixels.πBYTE    y size of character in pixels.πBYTE    number of bytes in a single character.ππAs you can see from this header data, these limits apply:ππ1) Maximum number of characters in set is 256.π2) Maximum character size is limited as: xsize/8 * ysize <256.π3) All character data plus 7 byte header must be <64K in sizeπππWe use the following structure when writing programs that use fonts. Note theπadditional words at the end of the structure which allow you to keep the actualπcharacter data in a far segment.ππstruct chs {        /* character set structure */π    unsigned int numchbyts;π    unsigned char numchars;π    unsigned char ascoff;π    unsigned char chxsize;π    unsigned char chysize;π    unsigned char chbytes;π    unsigned int chsseg;    /* segment of character data */π    unsigned int chsofs;    /* offset in segment of character data */π};πππSo....A 256 character 8x16 font's header would look like:ππnumchbyts   = 4103         256 chars X 16 bytes/char + 7 bytes for headerπnumchars    =    0         0 to represent 256πascoff      =    0         start with 0 characterπchxsize     =    8         8 dots wideπchysize     =   16         16 dots highπchbytes     =   16         1 byte wide x 16 dots highπππand a 96 character 11 X 18 font whose first character is SPACE's header wouldπlook like:ππnumchbyts   = 3456         96 chars X 36 bytes/char + 7 bytes for headerπnumchars    =    0         0 to represent 256πascoff      =   32         start with 'SPACE' characterπchxsize     =   11         8 dots wide (this takes 2 bytes!)πchysize     =   18         16 dots highπchbytes     =   36         2 byte wide x 18 dots highππ========================================================================ππππ                   PCPAINT/Pictor Page Format Descriptionππ                          Format by John Bridges.ππ                   Document by Microtex Industries, Inc.ππππππRevision Date: 2/9/88ππππGlobal Notes:π------------ππPCPAINT 1.0 - Revision 1.0 was developed for Mosue Systems in 1984 supportedπonly BSAVE files in CGA 4 color mode. In the space between the scan buffersπwas a string that read PCPAINT 1.0 followed by 2 bytes which were the palleteπand border information for that picture.ππPCPAINT 1.5 - Revision 1.5 was the same as 1.0 except that it contained largerπthan screen images and also had a primative packing format. This was sold forπso short a time that it won't be covered here.ππPCPAINT 2.0 thru Pictor 3.1 - This document describes these formats. The fileπdescription is identical for all revisions in this range. However, inπPCPAINT 2.0, the bit-planes were packed together so that the picturesπresembled a PCjr picture, or 4 bits per pixel, 1 bit plane. Starting withπPictor 3.0, the files were saved with the bitplanes separated. This takes aπlittle more memory in some cases, but the speed in loading and saving was aπdesireable consideration.ππNOTE TO PROGRAMMERS: A good PCPAINT/Pictor file decoder will use the variablesπ                     in the header to decode the image and thus be compatibleπ                     with all formats since the October, 1985 release ofπ                     PCPAINT 2.0.ππAlso please note that PCPAINT/Pictor are stored from the bottom up. This isπopposite that of most of the screen adapters it supports. This really causesπno problem, but be aware that you should use a Y table to look up scan lines.πIn all PCPAINT/Pictor pictures, the scan lines are continuous. If a picture πis to be displayed on a particular adapter, the programmer is responsible forπusing a y-table to properly interleave the lines if necessary.ππAlso note that Pictor was designed for speed, so no inter-mode loading isπpossible. If you are writing applications that create Pictor images that youπwant to load into Pictor, you must remain mode dependent. ππHeader - A full description of the file header information.ππoffset    type    name    descriptionπ-------    -------    -------    ----------------------------------------------------- π  0    word    marker    marker that is always 01234hππ  2    word    xsize    x size of page in pixels ππ  4    word    ysize    y size of page in pixelsππ  6    word    xoff    x offset into page where lower left hand corner ofπ            viewport is located (default of 0 is ok)ππ  8    word    yoff    y offset into page where lower left hand corner ofπ            viewport is located (default of 0 is ok)ππ 10    byte    bitsinf    bits 0-3 is the number of bits per pixel per bitπ            plane and bits 4-7 is the number of bit planes (soπ            4 color cga mode would be 02h and 16 color ega wouldπ            be 31h and plantronics 16 color would be 12h)ππ 11    byte    emark    marker that is always a 0ffhππ 12    byte    evideo    single uppercase letter indicating which video modeπ            this picture was created in, can default to 0.ππ            0 - 40 col textπ            1 - 80 col textπ            2 - mono textπ            3 - 43 line textππ            A=320x200x4 cgaπ            B=320x200x16 pcjr, stbplus, tandy 1000π            C=640x200x2 cgaπ            D=640x200x16 egaπ            E=640x350x2 egaπ            F=640x350x4 egaπ            G=640x350x16 egaπ            H=720x348x2 herculesπ            I=320x200x16 plantronicsπ            J=320x200x16 egaπ            K=640x400x2 AT&T or Toshiba 3100π            L=320x200x256 vgaπ            M=640x480x16 ega plus(video 7, tseng, paradise), vgaπ            N=720x348x16 Hercules InColorπ            O=640x480x2 vgaππ 13    word    edesc    extra information descriptor defines what is inπ            the extra information that follows this header,π            0=nothingπ            1=pallet (single byte) border (single byte)[CGA]π            2=pcjr or non ECD 16 color registers (0-15), 1 byte eachπ            3=EGA with ECD 16 color registers (0-63) 1 byte eachπ            4=VGA 256 color info - 256 colors, 1 byte each rgb gun.  ππ 15    word    esize    size of extra information in bytesππ 17    byte    edata[]    the actual extra data the size which is definedπ            by esize (at offset 15).π 17+π esize    word    numblks    the number of packed blocks in this file. if this isπ            a zero, then data is unpacked. πππStructures - These C structures describe the header information.ππstruct head {π    unsigned int mark=0x1234;    /* marks begining of a page file */π    unsigned int xsize;        /* x size of page */π    unsigned int ysize;        /* y size of page */π    unsigned int xoff;        /* current x offset into picture of viewport */π    unsigned int yoff;        /* current y offset into picture of viewport */π    unsigned char bitsinf;π}ππstruct extra {π    unsigned char emark=0xff;π    unsigned char evideo;π    unsigned int edesc;π    unsigned int esize;π}ππint edata[esize];πunsigned int numblks;ππIf the file is packed then what follows is a multi block packed file,πotherwise (if the file is not packed, numblks=0) the actual data follows.ππBit planes follow each other in the file and when packed each bit planeπmust start in a new packed block.πππPacked Block DescriptionπππPacked block headerππPBSIZE    dw        ;Packed block size. The size of this blockπBSIZE    dw        ;Unpacked block sizeπMBYTE    db        ;Unique marker byte. This is a byte that does notπ            ; exist in the current unpacked block. If no uniqueπ            ; byte exists, then pick one that is used rarelyπ            ; to avoid too much redundancy.ππPacked block data - variable size depending on whether 16 bit run is needed.ππMARKER    db        ;mark a run (this is where MBYTE goes) πLENGTH    db        ;length of run. if 0, then look at BIGLENππBIGLEN    dw        ;16 bit run count (only exists if LENGTH==0)πDATA    db        ;byte to fill run withπππExample 1 - a 320x200, 4 color, packed page file, of a white screen. ππ    dw    0x1234        ;markerπ    dw    320        ;x sizeπ    dw    200        ;y sizeπ    dw    0        ;x offsetπ    dw    0        ;y offsetπ    db    02h        ;2 bits per pixel and 1 bit planeππ    db    0xff        ;extra info flagπ    db    'A'        ;vidmodeπ    dw    1        ;extra area descriptor (pal and bord)π    dw    2        ;bytes in extra areaπ    db    2,0        ;pallet and border (extra information)ππ    dw    2        ;number of packed blocksππ;first blockπ    dw    5+5        ;packed block sizeπ    dw    8192        ;unpacked block sizeπ    db    0        ;marker byteπ    db    0        ;mark a runπ    db    0        ;a 16 bit run count followsπ    dw    8192        ;16 bit run countπ    db    0xff        ;byte to fill run withπ;second blockπ    dw    5+5        ;packed block sizeπ    dw    7808        ;unpacked block sizeπ    db    0        ;marker byteπ    db    0        ;mark a runπ    db    0        ;a 16 bit run count followsπ    dw    7808        ;16 bit run countπ    db    0xff        ;byte to fill run withπππππExample 2 - a 640x350, 16 color, packed page file, of a red screen (color 4).ππ    dw    0x1234        ;markerπ    dw    640        ;x sizeπ    dw    350        ;y sizeπ    dw    0        ;x offsetπ    dw    0        ;y offsetπ    db    31h        ;bits per pixel and 1 bit planeππ    db    0xff        ;new extra info flagπ    db    'G'        ;vidmodeπ    dw    3        ;extra area descriptor (pal and bord)π    dw    16        ;bytes in extra areaπ    db    0,1,2,3,4,5,14h,7π    db    38h,39h,3ah,3bh,3ch,3dh,3eh,3fhππ    dw    16        ;number of packed blocksπ;block 1 of first bit planeπ    dw    5+5        ;packed block sizeπ    dw    8192        ;unpacked block sizeπ    db    0        ;marker byteπ    db    0        ;mark a runπ    db    0        ;a 16 bit run count followsπ    dw    8192        ;16 bit run countπ    db    0        ;byte to fill run withπ;block 2 of first bit planeπ    dw    5+5        ;packed block sizeπ    dw    8192        ;unpacked block sizeπ    db    0        ;marker byteπ    db    0        ;mark a runπ    db    0        ;a 16 bit run count followsπ    dw    8192        ;16 bit run countπ    db    0        ;byte to fill run withπ;block 3 of first bit planeπ    dw    5+5        ;packed block sizeπ    dw    8192        ;unpacked block sizeπ    db    0        ;marker byteπ    db    0        ;mark a runπ    db    0        ;a 16 bit run count followsπ    dw    8192        ;16 bit run countπ    db    0        ;byte to fill run withπ;block 4 of first bit planeπ    dw    5+5        ;packed block sizeπ    dw    3424        ;unpacked block sizeπ    db    0        ;marker byteπ    db    0        ;mark a runπ    db    0        ;a 16 bit run count followsπ    dw    3424        ;16 bit run countπ    db    0        ;byte to fill run withπ;block 1 of second bit planeπ    dw    5+5        ;packed block sizeπ    dw    8192        ;unpacked block sizeπ    db    0        ;marker byteπ    db    0        ;mark a runπ    db    0        ;a 16 bit run count followsπ    dw    8192        ;16 bit run countπ    db    0        ;byte to fill run withπ;block 2 of second bit planeπ    dw    5+5        ;packed block sizeπ    dw    8192        ;unpacked block sizeπ    db    0        ;marker byteπ    db    0        ;mark a runπ    db    0        ;a 16 bit run count followsπ    dw    8192        ;16 bit run countπ    db    0        ;byte to fill run withπ;block 3 of second bit planeπ    dw    5+5        ;packed block sizeπ    dw    8192        ;unpacked block sizeπ    db    0        ;marker byteπ    db    0        ;mark a runπ    db    0        ;a 16 bit run count followsπ    dw    8192        ;16 bit run countπ    db    0        ;byte to fill run withπ;block 4 of second bit planeπ    dw    5+5        ;packed block sizeπ    dw    3424        ;unpacked block sizeπ    db    0        ;marker byteπ    db    0        ;mark a runπ    db    0        ;a 16 bit run count followsπ    dw    3424        ;16 bit run countπ    db    0        ;byte to fill run withπ;block 1 of third bit planeπ    dw    5+5        ;packed block sizeπ    dw    8192        ;unpacked block sizeπ    db    0        ;marker byteπ    db    0        ;mark a runπ    db    0        ;a 16 bit run count followsπ    dw    8192        ;16 bit run countπ    db    0xff        ;byte to fill run withπ;block 2 of third bit planeπ    dw    5+5        ;packed block sizeπ    dw    8192        ;unpacked block sizeπ    db    0        ;marker byteπ    db    0        ;mark a runπ    db    0        ;a 16 bit run count followsπ    dw    8192        ;16 bit run countπ    db    0xff        ;byte to fill run withπ;block 3 of third bit planeπ    dw    5+5        ;packed block sizeπ    dw    8192        ;unpacked block sizeπ    db    0        ;marker byteπ    db    0        ;mark a runπ    db    0        ;a 16 bit run count followsπ    dw    8192        ;16 bit run countπ    db    0xff        ;byte to fill run withπ;block 4 of third bit planeπ    dw    5+5        ;packed block sizeπ    dw    3424        ;unpacked block sizeπ    db    0        ;marker byteπ    db    0        ;mark a runπ    db    0        ;a 16 bit run count followsπ    dw    3424        ;16 bit run countπ    db    0xff        ;byte to fill run withπ;block 1 of fourth bit planeπ    dw    5+5        ;packed block sizeπ    dw    8192        ;unpacked block sizeπ    db    0        ;marker byteπ    db    0        ;mark a runπ    db    0        ;a 16 bit run count followsπ    dw    8192        ;16 bit run countπ    db    0        ;byte to fill run withπ;block 2 of fourth bit planeπ    dw    5+5        ;packed block sizeπ    dw    8192        ;unpacked block sizeπ    db    0        ;marker byteπ    db    0        ;mark a runπ    db    0        ;a 16 bit run count followsπ    dw    8192        ;16 bit run countπ    db    0        ;byte to fill run withπ;block 3 of fourth bit planeπ    dw    5+5        ;packed block sizeπ    dw    8192        ;unpacked block sizeπ    db    0        ;marker byteπ    db    0        ;mark a runπ    db    0        ;a 16 bit run count followsπ    dw    8192        ;16 bit run countπ    db    0        ;byte to fill run withπ;block 4 of fourth bit planeπ    dw    5+5        ;packed block sizeπ    dw    3424        ;unpacked block sizeπ    db    0        ;marker byteπ    db    0        ;mark a runπ    db    0        ;a 16 bit run count followsπ    dw    3424        ;16 bit run countπ    db    0        ;byte to fill run withππππExample 3 - For more detail lets consider a block that isn't all the same.πSay the data consists of 30 2's, and 8, a 4, and 300 1's.ππ; the block would look like this ππ    dw    5+10        ;packed block sizeπ    dw    332        ;30 + 1 + 1 + 300 bytes as aboveπ    db    ff        ;what to mark a run with,π                                ; because there are no ff's in our example.ππ    db    ff        ;mark a run π    db    30        ;8 bit run countπ    db    2        ;byte to fill run with - 2ππ    db    8        ;not a run marker, so must be dataππ    db    4        ;not a run marker, so must be dataππ    db    ff        ;mark a runπ    db    0        ;means 16 bit run count followsπ    dw    300        ;run count    π    db    1        ;byte to fill run with - 1πππThe actual unpacked data that resides in memory consists 2 seperateπsections.ππ1. The control structure: contains x size, y size, x offset, y offset,π   segment of bit mapped data, number of bits per pixel and number ofπ   additional bit planes. this information is kept in pcpaint's data segment.ππ2. The actual bit mapped data: contains the actual page image, mapped fromπ   bottom left (so bottom scan line is first). The data is contiguous withinπ   each bit plane, so scan line 1 follows scan line 0 directly. the pageπ   can and does cross segment boundires (a bit plane can be larger thanπ   64k). each bit plane follows the previous but starts on a paragraphπ   boundary, the printer driver will be passed the offset in paragraphsπ   between bit planes and the number of additional planes.π   The bit planes start with bit 0, each additional plane is the next bit.πππPaul Kuliniewicz               MONOPOLY (LIKE THE BOARD GAME) home.aol.com/Borg953           04-21-96 (08:36)       QB, QBasic, PDS        382 25281    MONOPOLY.BASDEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"MONOPOLY.ZIP",4^6:Z&=18711:?STRING$(50,177);πU"%up()%9%%%.-%TiJdE2r;eE;eR%%=Y%&%1%%%%rt%stut(q(SgRfxeL$TA#2>aYπU"4H'u4UR/Dx<oA5:n,6U/JN>Y+Rrh$)a+]T88J\*GF*'?y:tmzv+u4vtAce/K1tLπU"L5m5UC671[P&yZn)<KcTD^#Y?)%;J)$hmI[7eGjsRsgZ&MCdGoYuWH>hhrp2N#^πU"/;M[YSSl5H_Nhp7]lJK.'d;sOG,lYH3rI#Y#/xfWSJLLgp,:$+#]:bI*N0#J=V[πU"].6l:$,Ymk6oIi^L[MM9PM)pR+H>>FgmXJ34Ub;-vt'kLi&AL.?[7IYlFG4Vn2yπU"gB>U)O\n&P8BBL=<r7cT$h2gV[5R(x1_?=mDht8UR%Qr#FH]QKfh?9U?#.Jz3Y1πU">;*O_8G8a6xt;o+20e['K\N1-W%WWCgG&#p7Q:T=[C9V^pt4E2F*s5JU2'>IbkNπU"\AP>ag],a%TPAkFVbFA+SvzI3Z(R'Oul.%\09hl+GO-FWc52?G>)<$gcC%JmaSeπU"#g2rNj(TP#0FYlb+(h0qjaqS'Z9V=^j,+r*(bBe,Psl&?xYAu>-I14p9]t+,gBMπU"fh>$ZI=&Cg_(%7PN7(?.X0ltRWYFC0CWSTgeVb]W)rWZo?aKCYKX9;npW%].,D[πU"/QDmE'M$jDeU<#ZX?rxLQ(XV9XGHIwlTbDXYDJT=KxAl]_U6V51S9.q]W3l.a=OπU".rjs9n.pdo\guTo4'j)]1Iuvr5T_hCtsmD-hXE2p#8Owm<WHgiJYK,UAHWhGXQRπU"5)QhHV#m^k&:d9*&H9R/.aNc<p>iCl\QB?I7M$[9#?ZZg>&P8K=fC^Fa$+R4A*MπU"-li;Xi&[K8&=3i.##k]mt.M/k>N7#Q^sFk(MtP2pqd69jZBb'OVsEnZcOWi&$odπU"&=12lzd\pJ1nqoJn0LV>^37hK#[SLPaYy6D>ER1k?JlKGd-L3w[yo/1,JV2=6]#πU"WPZiv87pAd06=CKH6Z%D$_]\>+))^#2V$ip8OT)8sA(''S1'.UUF^/:9C>(S*n[πU"%$.6cT62y5l]QZugw%YR,TDkJyl(TmM>jbH\G9\a9RtR)7\iFU-T?4H]N^R#CqcπU"DeGg9na35$k:Mi?h[Xxh.2'X2F5>eCLzykur0qUc>I.GY\8kqW1MqfJd8/O,x:>πU"$H0Q-6saphWEsz5VY)O=\a;q)\2([8q/^/AW#4UC\aunxUr[Luhr,%[Gc$roW<>πU"A_i#__<$*4?H<Q)JXGZh1JxjDuShW.Ih,uHDb0\E5]p1b>UdD<rO21xU+,oGY;:πU"beM'Hup6T\8Tdv=SRnt;>D\JdcuY+XtgZ?n[_uE'5F^bc33C1Mbu+Lgp9^u>k1TπU"[;;XJfk1>HsH)PURgSt6u?c2mbe1&W7:,G?WiQ)G1)I%1dv#''l]4\l>+gPwA\IπU"'d=kjt?axnS(xMfv92ai>t:A32XoA3N#&U%46:\Hn6UAf5MKuAwXA[^L7W3Naq&πU"7'Po7sHTvVsNMbSbWlZJH1Da)nFw$hJC5N\aihM)=OoLUr-oY2n3+bsvTpIw=^KπU"nD3?vwibecmbWP[3,O_k%^ga8mwepkrjxT7%;._pRIfY1Kdvhx%Y]>?k/$8YxoxπU">'f:t1G0>k3<ZB>H1QYOC:Xa:$xKW5I]K3YYX\lE4,KiABi5]ia'c1H]GEF&fM#πU"CYp$t3l9/2XNQ_hI2'qs6d(BDnD+Bi+KiiLgklx[6q#coPk2^USW9DkH]qLv$v'πU"o,mca):%-/U(gJc<r;xa)Zr8['=Ubd<z7T7ZYpHT5-0x)GT]g8zJ;ffY,7c+iL^πU"3ICdYZeFlrZC-?Bq(S3s'_6xp]*EXA9fVT#quqJ]<eH\lj%Ddgy;&qo=e\LrW9YπU"2s3*RDmDHHvEafK#_UfjhaSR#q3>'3Hm?)P#LL%6WQxDq<o;Jg7j)D1S<ueQ+cGπU">1UX^eZ:%K?#Jvgmr(f/U/c=B1dCX*_17TM(?2PA1^HG,qI,#dYiQt1eI<;?j4$πU",OC$CKVH[68x#(3.5G3c9bCRU)%pVo/GD8OZaH:CVsS6uvr'\S_Ugx6/&)(H3q>πU")M90<$#c1fV_Pd&+Se'LtI67Hu/2iU/uayATKh3FDgEOTGJlCR]gL<#=oYnpm)0πU"FROr0FroW]cfBi?n)3_7b1:3&tPt[j$2=6s\OWKju'm-TWJYLGuMx+e.lBMo$*AπU"O068#8rEi^IIK0^wbqEEXGfgU0Qw/Ys0wRK:p&n3/IiJvWn%L#CNmtobo\7lLfnπU"m#zGi3E\?5.]CEaZM7>Jhd)kSpbXxTQ(P_,Uh%u.4HwF9Hx,m)aPw*x?%q8?\[&πU"/d$Q(igdY*AU]gXEFf1slw&8B'Y<q9Cu.?.c6VE5'Fe\k]41-K6+SokVEU*/=tAπU"FReO3NSSYtd]MIIf25A^/:-dQlA(s[]2l6p/z0H,x+4%.Dm;..mZ9U]2wehq??\πU"<gE3?WnDld9R^mYCtKH<L<Al']6%G?%E)OLVUul:<]M8Kf0PJ/lj.)#-:l;H*.3πU"f#r%Ve#tI_%\Q50N)N=IYUfHC3=mm:(-KFCeS1K]'FYs_wFKHjg&/?0X&U==9ZKπU")TjUa0r,/eL;;]kU8P35^i]Lf-.JojE[l#+W4md?cop-tSXeRQk/.osLflCV4/&πU"he4$#m<0WT=B8O]S#U6W$rBJ_75c.=sqY$%KTsSq*;O5+iO#4(fS2Q_HI0J/2QGπU"d-n[#B3hgRD=*bNg/<?8V.1&]7hDuEY2/<3ILn5>9fP5=e.fi]A3>Pgy?xAWvS6πU"7OZvGn5QtXEIlE'VS;9-a%s]a%M$wvl=r>#su>&$Ft+#\VfS#k%#2Q:aWW1ZIc7πU"Dj'TP,v2a\dytBifjH1+,;vIO*?xScAhp5>I?tmwh#X+1P67I$:aE*-?av+\/L)πU"C\qr<JQl[*4HbPHCgyJa./b>0lcAZuFeIkR12otocb68ZX%6pRA^FeJ3XmcDEiEπU"O8e6s?d5Ia\8-E)l%Yl.BgRGGO3+?'&mRCw'$=C)>CgEGt;bEgqVgPP8$J<u<s4πU"0fL=9N%hM=Be-TV<oO5<;:#*^w8#q;Jw\)-w;:i8=UU);u<MJ1Nms$0AI6DMYI]πU"\IQ/xh#o2(i\YCZx6t)UmuMLqfV)aP7&#C+D*25_LObKOy:2/wf,ZbqkM7RDUJOπU">CDION3>QeG(K1Ir0-4O6hq:ss;cFLF_///9/l\a>/LsiAeI+B)g8:0+*f]b/'CπU"VQ,LRJd[(hA=z4FK]a9sPvReaUr\n&&So^l+UR*H+pEtQMF2E9T9XL\E$?#mD3tπU";'l+5s4K,]Y+ihi;?hmq#pUr+qjQ0#VO*^wb]p>mnw_xZK6XX)xN$cMe<ZLL#^$πU"Qi:O?eo\lY;ZCEOJA)fd[n%:Ki\ppP)X$a2O;a+4-2-q5T,?d;2I%81s2YbS'IpπU"V^H_RQ4,a^D[d_Dn%+8yf=#wuZ=H6;F;n]3--vMBEN+TOIVRbq&r8^Ijd\hSSYbπU"q(F>_t7b=fa%b:g3$e,OuG0Hk_]neDt]T\LYAn$[u$<eP/HIVL^INru)o$A.6_>πU"nF-]jesXm-cXnkj\.ds3[('n>g^Z:RHuvP020>?'_k:ts4VSSz+'].US#RARaF>πU"^?=bwla<'NWC7B4Tkgc>Sl,wTcD;\]8>,]X3vH0XJL7Qeg1QHOSk6MI^qE8J-k*πU"x.k4U0_#bODPSK,mPX4c;$GAW$rJiq_p<w2'k01B&N#ob.w/\ro.b(bV?^wud(HπU"Y$Pz1AK\nJ,*R78OZxfP.WxlwI_'kpAYB0X,m8We]>eOH#KBk$M%Ct_-oQzk$BXπU"6G9l&%MW\7sNKQH)0]m-RhKBBUK_[Mni/9T6IqjZU(pp)pxt25'-dM>SBe2M]04πU",Nc/l\-zUv_*/\efMuJUVx%w)HRBS4r>tq2;&dMX2fUTi=/l4QMg3:ojYER<.WUπU"py(ngR8HfJ;I\TOd/2JLH%:IJUTlQX/EN6wwuG?8$wPalDSdg%CO4$RY8)9#6e,πU"ZeJ#;_UU)_\?P0_gh[:,;f4$'fn<BK>j.Wjlxd,3Z/GcieNWJu8.ocbd-M%pEd+πU"OuJJ7_nCFM)T-?#qUlacXX)?c-\+bb;s<qO+qP#&_g0l3TFmkc_0u'tI2v_i,1%πU"xHy#?7$-*ESlUV:e#[4At4f8:5e?L4U,R5/PGENe;Qln,C4]%YY8EFfHS^RCAe5πU"F&,-EV%HeAG8.-96O<okIUP^'#CMO=O4Mn(H)ck'ivK(DAQ+#P:+7uyhK<OtL4YπU"m(D6=/<3<P_*cGU8MMF0,/<_MQmagEb)g>)5wJ>+:R(f_^[9FBRbKRe2;VoM+dlπU"R3G^=MR.f&4t%#qXLGm)3Slb/A[ga1\OeXi*>wH/Aq^2HiDVXTO<0;>/_Jn<uoOπU",)5%##F'Tel84(Duf-#q/0ZQ_(#Uhn==m%2D39f<(8/4S41>uV&=Z:.0S%8)IGGπU"uM#1>eeRIR=#C'6a%<KpUAQU-Hq](ya<QFgRcc>,qG1GTGRmMxT<x-iHu=DNAH'πU"K910<j;Y?beJX'Yq,CS\<g%.\<qxt&p;=vZ0iA,1*9NtM[z>yIe?ItmN.cn2-q6πU"xJ:.K_,\w$]J-ksQT9jLO/9I[R>)]IQh0c7&O0gG<NTX[n4rcl+.GBch)^rPK$=πU"O]mMY(:k+bw)x+PEGq,3&9Zzk<.04qo0./N20A\P4gr:OD<\$1E[M5P4)FYKKHkπU"cVf5:KIThxWmJ:*=lJ0#*GT4i&qMOUa/Xy'7*DZV]T2z7HkPWETsL\Cpe1tZ.O?πU"_)bYE(H:TRn&#H8Tbv(LI&3)&Z-M?]'9za]>It^8k:]AE-T;YteA1I-fga5e:X)πU"grP>8HebIqf-4WaYER*.k%4S]pT7PO0TJ[oR+nKM4kdBQq7jqH0tU*9m=GJU,XIπU"\NX'M4*Nb.((k#=08=J:EMm0:1mTi6XRtI4=P]',Z1%hcB'jp1(:SdUNNHb63R(πU"EsbG/W&nAh]/AQfXT:Q/OdW]CVc)e(V>BM*L[MV1#rw(Bv79D)QbSI<Ed=e=]LWπU"R^CCHa55ixk9wOC#1(dBMr2CgJ;%zG/Ayrpv6j=\d;l8K70uam9:EBNZt][O0ebπU"Y/8h_emTeb+d+bk7QJRd*5&IFk>?2SUz-4fl[%KGjSwj1<^8/[qB]e<Gl#V(xCWπU"rEvBP4^ryKDnv:AB<rki':7l-.FrOM&aJVuompAASGkN-)5nXJmW.gJjxaD]2.xπU"yIC*u'a1jq$-$H-J8I4)d1OSWyp\LPRweRVN8^En\p%(TEOCSiWBW*tH-]t$g72πU"lf>iYhjm8*^J/dp<N2)el;]u$A(eLO9>6A<'$M)j99qNYb[+C+6roM/v9YG_etBπU"s9Y\q)l5^>:u6Plh5GP4.tTIPPi7'+hg/Ek:RRViU%GGMA<8oCsthk3?o%0n+^YπU"sz$,4qj$TCnck3>=nI;T=[g[&UV61E'4-:=jAgCf#TqRJehxCOd<KeX?tst;[taπU"EKh:FNM_'b<waULpZcO&1'A;hR$;rm:uTdsnqd,-_vyf0ZIDPw+G9&JRmyY_<&1πU"qR^fxDq[)r)dY<(Xd]Rkb?h-qeI]8*1t_m+<oBhUq?sGp+q=,PMbf1YH\7,]w:ZπU"0q='4rOTh9;e_g&5QTXiwgCL5t\L1b%DM5VfyA[1T/L&9l*oDsXo,Dbebr;]mGFπU"(,bJhKU:SIJE+1Z]tW=#HG_1PDMr?'g?X(Id>P\*N#3jf[P3ZoOI$]B6FKQ_u_PπU"c^4D$PvsHmCMr]XpVw'jotU*:g'9\;NvZndA_R$;/=TU#\e11N/r#%'b9OrOkjvπU"rY9.mc1GAN*cg;lTmK\(s#FRVW0CUh3UNT+iA&2l\^V[PiL-jbE'1R)Og0<yWRYπU"mi_7o9(;a4,S?4))7h%<oE4z/+lXu/d[E6>(k^qreebb(Hiod-u,b^9yM9rej<ZπU",RcAej<ir4P13R,siN<a;EnoHd-Ohdc^k]:T0Hjbk-x[]KuD5YJLriU:Irid#jUπU">\J/oSlMD(NOeIeSAQL-Q\9:#87&kJa-iha-JDJ^CK*XbZLpY<_l.WH)V4uW,r?πU"-v\2&skzc-TCQ>y_[5524:x-=+kH1R8i&X-ZMy[[m_e2*i0g;re5.$FR0:+<up[πU"*uD#82itv-1oO]YFI#0Ab_OJ::t)FyEUN'FQdM.DP>UM&np<m#L<6,MrGAUf)mbπU"8-Q1jSc[rt?8JZiZj.$F\ME$$5,uAjICltaPm4x=yxqNUJLevtFI8;:I2Z)Y?(aπU"y7,Ua]e/w)SvP?>OdkcUSS'kWNQEe4I[+1_#6T?[0tBQ)V])A*g1Aa%dgXAH3PCπU"mIz)w$pDraFC;g+^7H]N5G>d+qi#0>/U,M#F'q;,Y(khpfFSuUII7(*/aL=GUs]πU"L63s<;DNUYfWia7.3;fSfk5j=F8Yb-[>33=Z3XmUbH=1C^V\EnfSS$bZ#jKi9VpπU"a8UHP]4'+K4HO45Vva1H'Ey%w#]e&AtFp%VWdrW/Ia>,_9Qg\<>1D6PJ?Ue2ZU*πU"qGaa5BSNVT_?9E82,YLgZw8u+DXIGeH'C(t-du<N^8NY8S7%$5M+*vnyO5^T2?>πU"*_Tba-certTgY=Ngmx/++n3,_oof'NgOFSiRB62f=CmJr)APg(Rd<[[weC6-NFJπU"351Y<4d^pNZ5.XZuN\10SnfFJ3%xd-E&C&)Mns6[gHU>',pg73^-;>E$o6P+OATπU"K2mKVA*wO]<fz/:nOnBE77XU5,2nEi[j4+I*;n\Wj7*jUwNb2V?&7$2$-NBn5uLπU"._^vf*tyQ?'X2+G[hZEXilhN$qPR?Wja3(eLu#$<+c+Cr#98Mh4PpI:BY5vHP5:πU"%_m0F;Af/5Cas7<&^(=J?V/[)7IBEKx&+i-8)QilK>+\?%GQ,)q^.D:TCph7Uf&πU"F$8)]Lt72b\aLqJ5xe'0p:IX+qlRxi7d5TMu;W\Mce7gOoQ8E<LcV#,CK'RCxPkπU"iW6>C=,uR,kuuW/L1'Vu'o&YtAtc6H2q23X43WgfUjWiO$d#^GA<l\u$-[rk+4wπU"57&[H(RWMTe$Ta;hGDTEi*b%RH#RKWre$8$;hM-TAn-Ql>ZgM4$FeD<ekp*0<H\πU"jRWp/qhl58A;X$HPVR5ETkC,\Qe-H^fRk5S*;oXWcL_bO9A=N8>-;AphjF'<KApπU"jF>'<AoGHa#hG8l3:g=h8lEg7=hjNo7<TErW0[2H\t7<dl7)5ECK#;Kzn^yxLCMπU"eyEVJUbT/;y&A6hQ04>%ijwIB&BVQ2%1Dp.&2_5C?Bn\27#8KR)^FCKinLVpi3LπU"lMEW1x+]gmp^WQLY3GrF:Bgc86=lLMMqqMbG]K:xu<p['i_GgO/bKCJbI*_E6?-πU"2Ii+v_WX1g*EBgQ1Fo5R[BG.xzd;S^$%;M]NU?/IUctX4q3<<B&ZwoYx7xmRT8>πU"^Jb%x.hj'Gg6ybLp-j3wq$w4-H#K*5W.wo:#uj$qOlBo1V?v[hg'$KFr4M0j\4?πU"E<2J?lcG+(<pjD,f^&Skxd&YbNHKFp3C>z7(G<hVk[uDp&SN4IDd*,Id0<V;m/EπU"KJ_r8V2SG04,XpuYC4m>&PlMof8ca]Rm>mDB>'0eFD:4fSqPQJDFP8R6x0g-/\9πU"5#A%#p]5sGRCWB/s7AQt=(KArw'G?8IsbHZK-lh5mZuOLv]8IWxXb>x(bYx_;WHπU"VcK+ZHB*sQX)xJs82wJeFYk9ui)xY1k]JUrw(.b#)iOkbsX)iDWYkEF3h0W*(C3πU"?k2M-GgD2Z&1yEii)p#fOlA\M2HaYvKKEbleg/Q$D:0%aqOb3lntn1A-JmR3-arπU"K6T*i1Ep:WBqgn)K2qHZM$C]<sPT,pYj<6v,E=7ujL\6?Rge4_c6gghVkjf*aE-πU"jY-3G(]q%Vc3kbCQ1VQ];'(j6?rWhr]oDNu$H)rF5sP>1kF*A^Y\P*&\:\SR9jqπU"5d>fww(I1cf)EG6(UI$/)a/iN2B_CGW2ln;2c:\6a6O>Fp%7yZPBEcgf=0#tmbEπU"+4J7Xyf2jKN9.AH=8K918xG[&(mZdB-*3K,HW9n6acp++.)ifK8s1GQ[Q?Ng7+(πU"C7o97:35aO$i>-/4Q1N,g76GsXvQE_Z\w(>^\^LfOn(RuMB7#j;\a^gK7=Pa>KjπU"u2G]XQI-w?iBYy6EwBOcCv[]ocJ8swK=tl#q[OFX&lUh6.H8QJmhdp0EIGHTCC<πU"3wLCAlyY'(;#1;67pX3Q^P-A35v<h6gG]cBS4YclS,*Kh$$^WksWg%imp%3+_n<πU"5ds9;4Ns]1icD$p$l[o<'?\1c;qtmJC9$on?X\I,LjfYsC3pCa18]aQ.4aICVgjπU"JKSb$sfbu]](m(u^2+3/+1wZBDT4F_[(kp)+'U.*.c0:hAZ$4C3#G$QlQe8hsKVπU"k%cL(q(v(m)s65X_^hAkD8N[>g8U(U0NK4%DS_\?/o&qO9)ymy.RFiDY0pT6&V*πU"s%1tYsF7a0qgYnu2V%X;]Xi5Bx%uXFVbsA>iUguUo#mdFT42F=Wv/k-5X'T9tU]πU"Ie=[tq%YMp-EI:k+1XJ<2+VH4\[i;-U4yvBF>t(.hJDJ1F,kC-A6kR>D6;4Wd_NπU"a(Qz>34H7#L3n=aI.^Gzrh(H<Rl_/;6FR4q*2E-*2_B*26W&UIe_)+TVrKfv+&YπU"Gz*7ZJ(oI;chfNq5%d,c$#9/33\pTBV90+)b^U8ZnDccwa1R$OY0desRltKN7_wπU")AOQiWrFA=Qf9>L%,I*JDJ)oz&./^N)eviof1tyWWa507ElyoD/i9L_r^rxDSalπU"xf6maNm6gh+Wn>nbATvWXT4wWQUe=\XG5ac%iU><7z8CeW+r<zUUe6/s5dzu9TtπU"N<&sf%rrhXJ1kqD.iViM45W2-#t-%Lhq&6Hg&$R8rkxo&C(R\42/cjYIo-&bMO8πU"n%tK28'$Hk3nQ%5BKZXhTHJt]tt?SP_fAYih=?,B(2)6\HjvhtsYdfYzBSnyQS\πU"HJs9$qUT\8av0/Qp[bbS:7;DTuf[nm#U9^*OPGhET<3p^?gUaHeq$*]YP3:iHAyπU"PZUlHU(T1]1_+&>)YyUlj6C9iCze;+%t,?YjEPN+foPvtI7SNX-ODz(Z37t4nzzπU"HNbF^9>*:iPZmVQ70<;NEuPVAQK^JeX+lf_];C+Iqx6*Z?28L>1Xbkapof3mp+kπU"3h#;:0oa2patBP*+N10\*J^Q7w>QW6khw1<x1;tV+?s(G_<e?f[Q3U)X^+c*5unπU"=n&he4*lVX5iw4gRErJ(YBtODoVe$,eH12y5qS9H1f%Nk.LdPC)pGBl=cL+yrT-πU"WQ7eW\o,]j1kqjZo?Y39rxp]#2ggr$j6K/.Qw$Y4+l'U]d#s3LxK3JZDInEH=>gπU"Dl,4m7uHnQoWpbkPy'SD:5-W7;fIbP+xY(g4CqRZ-&o594Qns13/3JRNfKyOnbgπU"I3txoD=lM_7,pdm*^epug%:3BTn)[-(Yqz=5L7Lj9MH2)QiblBj73&v;Rt1'4?kπU"\7DgQb'HVRtY9AKU;[PCJUw/a.B1\2XNSFmKW5EN'q9&G$'xJl'AU+Xof+93dt3πU"dJ#jgoKc1ri*W3XtS&cYc4q:_#(:7+$Pbk=tgxwXA'&>)t&ulSaS&ju&oBH9e>mπU"?hZqB3fIt$6WE%R_?ceaiGjo$]9MW(Z>F%nx7<LqHE1cr;9.41M\ZS%kR)Ab3.tπU"B&ZNv27:<>==/OYSFUL%G]2XcLp#dNfqP:bp91NJSFoWfBfe?u:/?TeWS3joO<9πU"ZEmU\6oel\<%:Z#%dtDuFfq2e4K29i_Y#xgY1QKBX8+Al1z\9t8o;fe7DboAFpXπU"4/%%-Zw7dkyB-nm5f$)]7?g8eRFcm4pbrzUO<5f1/\mw5*E>E>MFmHh9o?bXq.<πU"3T,vi_kZBU+Rw\U;dIxy:Imu&eeUG5G*]It5:d5:S+vvLm8MNx.[-?LUnKL:\:/πU"\A.$U8G'j[=K=0aH-k,7^jVp%IPC2?Gp^GG%N*WYt_sXfguzHUGr8pF7cT%Iw%pπU"aWK+<YXa6qbnqpX=Rrle'wayONPd>*Te?Vzu2Ev[O70Zvo7<2Wm/0wAhq-Qf2l8πU"S(K>L(A.S\x9:zPJxLjhnhK7KQ[?8GjqKRJF5'm06&8Up/F<lsq9L6Rb+9-)8[HπU"J2P?p-<U2J%ej9D3M8id<LF<XELMGP$,hNtB,kUfaC$i=93<>pIM*8S(yY>#;rzπU"N-,fw3k6J>_;?efr[[a$4+=mKDOu$<Fpa$VC(wK7<0.mAvhbYcSedH6&TE#Krg#πU"<&Gf&Dcp%q7[WrDlBSKnr,bhSuwUewX7-$'>;RUZE;_.1:qv9;M9]%o[M0uR)N%πU"\rJ3aq-2Zgi9e4.,'j-T0w6E;qj1M*^ZF;2rvj2,^M>uAYz>[Z:8.p;jDGsG94cπU"n$fgT9V)&oMof2Q]iuM>0mM)GWR)*F?xCSkNc<MJdS7#w.LIQAAXaN.7v0c?kXeπU"lmm7*J)CdH);4v5BX.-q:KJpZQ1;f:z#Z_]8U/Wt&&m92)8LlWc3..$O%N^s/nlπU"g/\8qPu1#+7?hq3;Yi.*T%KYzeSDN$gSm\n>%U>t&=+[PV=pP.o%\[op:w+C4m+πU"E4WRA,gnc.\o2>rmVPHi?-&g&h:wRci/ko4mc-5G$JM'=xD39x'pXRSGWTiT8fQπU"S(jp3/b'VvEZQg/uQ3uShg,42Uz9vHF/t)pH,9U0_U$dvjmh-[Vgu_i1+%Bxg(zπU"(OQ9+;#rt$fX#Nf\BNgO:4NxCJ$BkXBN3=%3c9x#m[G,R3$Z(L^DOlrzD8.bf1;πU"mEcMIv[vaN8SzDE%nJ^<+76X].\&eX_;wo=(86W$GqND;*D3lm.&mgPhPF$$/t$πU"GnsF]2HPl-T$QXgFB?\D)kQ<GbLbX>-dENEr\u&$wFVO(Q*6.9K_s7b)rB#-cVsπU"-o%9C?4AmqC=TaO^hh0AUGe$n1,pMK<+In,ap<&t0crkq.d*sI'(0OI'N,=7xgpπU"r[IZ&+O/+SM>)f)p)nqL9A4Yv1i+7rYnDHGhgT<6rff(4XT84wY<1raZ2p;^51,πU";8IfQTr>'&mS10.wk#qPcs5-xW_rxO3ErjCOZ3-Mi$/T3rLoBDjvXJ2+GTBgV$fπU")KAe1$E-#%*s]LYvCMh4.[gU<BR\K&YMRIAkJLM1]AG:D]ONyMYGkiqmb.YJkQXπU"DehUG3S,p;[dwC^HWTlg%C7<*A*KrI8s+ZcKBM]85/Mk&Le\\sGPT/*uN?zVD>_πU"c<B%5\>,%S>rnsWw\PG.x:$,.[tj6%IaOouzFT<0Bk?,8WXR$(hxh7ELhU$FJJ^πU"ffpGwuT(8w7$G89Z;]W?s;LN;_X7e]ATdJ#_s0VeVo8[pO%D$?a?9RJ:#K\,NpqπU"VPchVC#Knc=rY9YX<Ab$]zp#^wZC,#*yi=SQ(Ou.)46>YI)Z=_*p*Hy)iqk3fPDπU"FW7w0heI/0B]uI#7IaHi10V;7u5heM)[G+g'kq:$XZHDCW.FaO0Q$K5QV]6S$%#πU"'\SQ-M*.B8\'fSU)BAs((Y^Th_:#IXkjVMd#0;GDm0>xf+Jf#mF^,wGO;w_jUA9πU"4sUk6Yoj'M':%T4A$rKZ^/EPIW>NPo%3Yuo-PfGn=J:f%5Bo+-0E&#/h'(Me(IaπU"dBL(iU><Br.6+2W=;#V..(.b0LBOe4rhWR%U&p9phm>6_^l13D4]8g56+ao;3?FπU"vd:AF\QFj;(KO:Y?].hYBhn7U22:1bWJ5lmo8/s^_NG-FNutUa:s;E\s=GST_NWπU"eC[g\Ad6]aw8.[tthkai3s+$3f7z_rg[3VafN*V>E-,(%83Wk^LsJmB>,^oDL)pπU"f4BL<?L$ON$h8.F8j<YA6l<Yi:DYO)rer4ZonZJJHS%2AKs+xhPin;*A>=aR2beπU"VWP8=/.4cme;HmcUMWF<+2<jD);T-UoFl9Fytm;w<A+njOFX4\]*'<^us[i(>qFπU"S9-ru]srFXrMM;4MUhI:b.A\:7d5kr9i*o>Nl^GLL8LE,TA\->a0uXJG6TgLpxMπU";8;5UU[_TKxt7RFX)hN.oxiA_N99d#bda9k#CN[:9A_GdyAlriv'.U8&._wLE.PπU"U%liFUhzV>roYr*0U74dHv2%(&uSeS_hwYd]PJC&4uc]uMSsIlfpVh9PhR%7K(^πU"qMq^oKX2.#lLOvX;a'h9P+yScm]S;K/0a8h,$tbvhD;z_mP[/y;(;q61_JvY+%FπU")[yYklMe1fK<&WXMpC0+j9'7K>aK,d+uZWP7MHUXrWjZ0^S8fa7c/Z<4,W'%M.-πU"]2cV5K#2;6GBwk;_>)#)mBO&#<ou6.WTpO58;<BO)/JCVa.TJLfFfBp>I741HiMπU"208(g\M4tvj#4L*ltgUgCNHr[.P0\T5tpeZmG03Hr#a[Bf4Z-Yd&jM'g.pIqD]qπU"*6*;bXF-p^rTZ=anu^kC<C<OER[XNtD29ZK/FcLY$0+KZ0)kRu/kTHcB\P8FD]qπU"H^<6qV3ek*Q^:a\SNqEXIT0WR_YhGvg;EH4fNYAal>I4psAb2;emj1U*P7Y]2,kπU"W]\hgMt%7:(aHKV(k^HP50m)Hf$pG.eQLtx,iCquEJ,2FiqtIvJ:U(icEZWrbhrπU"s.2MFsw[R'FjP?1kiK;o1rVT(S&.U:7\og^\opAVq$T.d;<bd-j\Gvfp?y<c7;CπU"iF2ttp62N>ZGmh[qWZ.t[uAxEW#Top/hajd';0r0M_+er[*uwDC6SD;QZGaj_vGπU"=Izn3rSV$uY>aI;FVYBdMtGXjG>lEc')61^jmAKBX#G=0OIV^))zT4I.5-p(/\RπU"O]7aI$n*:nbmF^X'\w44Bir\Ysik_kX*%w446Br>Pl>(Q1nm#2G-;vqSkpITtB0πU"FaGa5&gjI2WyehJ##3P3O=nL=>i3Gy?W>P5)UM>Hsm<(]>LtW,L(JH.C_]:A5IPπEND SUBπSUB V2πU"L>mBr2TR1$cF6&eF\i2']<x'=#-E*/1\%ChYb/ZJ^L/qIhXnc'JphRlGyO5jI[+πU"0fOP5Kl$efuYVtR+ZSkPpYRo*5#[h-P.:)*pj[jBJ%7(i2\Qh\*Jj-v6gHw6Bf$πU"q>RCH88I)DQz?D.Pc\5uFw/>LbL0B+k5DnJk\-pNCN%wm'Z^vf0[/,=.t(gu;w$πU"pXJe8A+-tDrL83VPbvHM;k3Z$aiDo'6MJI*%Uuub<0NTKX[MxhU\y&QKd;)(5[:πU"iv5Wor?v*1dG\s&OBZ:;xtK#t#bO_rKk,BB(yA4&+;s].PNAEWgPPXElvl:]nk6πU"Rb*l^p+HK6Mw38Nnf9.c3TJiq0#>(,hvQ;,CwdxAh;iK6K\lDs00jVY;Ierah=CπU"vu9vSj72fK(ptj_Ld,/51:a*1??WL3q6/M5,$iPG5S9Jm#]qpTwx:1$#/mw%]6LπU"-GrOKu7:YDbT>ap.YjoMgacePeTb-rl0=L)V)pxE'p-=#Mi.xI>[^FW>i3glms.πU"OoQfDUbeN7ShaD-J'&]fqQ^dDE1g'ig&)pPgKwpUP.M8fn^q>sx8lDIYp&QQr#nπU":F*Dwc'a^G=m/#0bq5tW7Ous(wGhrodl[(5L]1[CA4cZ8:<5$u]\s;9)(v<ju;pπU"t4E]=P2kOb5.9Xf-<\cq1G4C20#th5EhkUaRfWmELNIUBMw[(c67)ws5q).SWHqπU"exiLk(m0T%rDWZtaFpSSLiQ'llUN$'E3j[\f5p0)I'ohv#g8BLqMi-k4)Fqke-EπU"E$dNnQE)dN=f+]<Fc]^FoD(em_o48Vbr-$6,u<v0oU5sgUoR+$:O3w^[Q&vWf:0πU"RjZ(j)PpJ.Ln)*p>SERPQ95lnV^I**6gx';5&sPT7Q3^e;q)DW/1FTL1-HG1\RBπU"C?D,\UbU#R<pgNOx:)Pt56j]1RThL,h%NrC**;HSc&eeMq_-h'Pi:HG\6u9\D[:πU">5>6vj9[/q,MIbNs=[#Ig<fztVQ0VU51G9/Dl+UyAxa1dnG$2Gbu^'$2wmuob'BπU"ix5#G$zg%PE5Qsu(b_q96%HP(9/C$q(;W4a*Zo/[Q%GL/Ad[G(mnJuNW4,5a$v3πU"D5,KPq;[]?vNnaYya^4J0WFLJuq4xm(z,lm-n+2WNukwbU\9EqvZ^EDX?_G$-LyπU"L6Eap--'=J(p^&n_cb7w=+7-q8+vg3L&/>G\OO5f09OM;CYO7wf)qs;Q6wNGY>xπU"87-l:lfwo[c6meg&PPO=>Cc7&linj(H_U.Yy[?00Kr>S?XE;#O*K-+tF%kWC)>oπU"<=bna7uJ)7W\$]P/99R7ZhI^P/9;R7OTs3QtYi;-mXF(P'MSY4W9-m<F-ONdBKWπU"V'sr:YOp['M6MzqT.?W?;?N:;B\P=QRta[3ePj+J4N6q+T655P[Vf4ncRO1,+]:πU"Yj>Bbsw9ohJ-\n%\YC[5Q&0GAfqn$I$j1hW0FkJ/[F#dOtWZLNY(w'bfTRi,Ux'πU"2Is%KX]WK%7(i*8%$FNuFTsz*MXz%8P>1v6Z)oGiY%07\HEj%*DK>GFXlM]RsWGπU"]1u*wLZMSoPcnBnzMTJ/>nX3rbzUUR%i&FRozZ6vv9VP,UTp+OhYP#C]qEpWEnnπU"qLn=^?OHTB2ckH;,?#IiSzJjdhs-ow'N:pL2-bU$YBBFcVCJ0U0K$o*,*61h]l0πU"WkL+TwVlNf_M0R())nN4kxIX)FAI:<CUZR/_S(S=0S'uz%c9bT=HANrPf0<zhXRπU"C'NIm2Ba1IbMKdhEb2wi;F5Ym+oh1CgkDVOAuq?uZ,TUcv1m[ZF6GM_N\-XQ/rqπU"tN1:kD=ro1\_7^cI>:+BZk\Z8N0Sv5eMM,cK1n&?^Fx>wKQ1w5&SChY[AGD\+pSπU"st2Tj\8kQd&=Sb'l>peC6IL::>Eo6pa2y/]e0.B_'jPcX4J1eX,)urOL[KF3H%\πU"g<MSioFW3(8KT-IlHaI.P>I<W]7Fz7Y6W*[-]<BFT:;54eBaBEao1>0KL2k_qYvπU"+Z#Ql(7'>j,5f,/l2'WqNO]#&e?LDtYK7Jd0/d\5ulaA$tAgqrV<Q#D&Xdx\H_)πU"Okf[VT?ryX(.Gji]tbA#L($f+f8:.Crh)4$6moi_kZUUR4\Dy1w30n=Jsf48).jπU"+$3+G68<cP3goOqmSD.;E/#D&hF^DR$a+aF:^4uIi'B3Q-;EsLN^Nq$%5<GILdUπU"Sw+_g<00'4-co=[6dqUY/>1<?OYh[LD3IJ*HU+KZ;]O&%W:?W)q0[eZU:]V/uEtπU"LO9Y(\/u-bdh[QpMLy.c(GX8Y(h$9G[<*xJp9BA4nQ7W_^lB][U^^cg>*IsqMOoπU"+g%z#u'20ycK\>.oVRk#.:]U&Y&>_QMuDi,O3N^*A(Y*^-w-1LGO,vfqsKT^k%&πU"nDw>h0KmABUg+v*fKsPfR?vfRqsT5OsT(k'/js8*tW:FFK9?M?HB4;$cMiWoL6EπU"weY8a8SE64+<?;-]OPr:&ATxU6rl3JK6C3A%gt/TmT3.E%]Z7tV7P<Hu$qf:j/:πU"4SY$ssL.Xk20(edK>P8'Bs;Y5ZvsVxN,SQKR^8Kns(ZS3OQti,*akO/fY*3Q8&>πU"S/f$h)aFv(S\LVBQ_Pe-K+J3liZj<J.Ncxztr#uBF*V/y6e%,^rtE5-\?<iV,[7πU"J-_sxik+[I?eqnp,orH3WW8gJcRSgT_^\?d#*lTBJ/4SpCn+NA,:.=KcYaf2u7&πU"(tde(dj$IP$<V1Br<X+BZNBT\UflmRHPn6#DoK/+I1>_U#mu,7ndhMr7[qSjP8HπU"(2g>a/0-W\IstO)_^n5ib0_m)vb#[pL/df(SMq>Ih4jSuZA=rNfr<L/xDj+-vp<πU"fJVUA='Q:JTU-N2p?.+VVVkLz188A&.nykI*dP_1fV>NDp1u:zKN_E2TtQFYK]EπU")1/cgO+*4ePxr$1\n/,Uk+X5K7E,[PE1q0*peNZ#Rj'=&[we4Qgl7x)PTc%06n_πU"0sYD41ILHvIr$)IH(in5#nQ5O*TuNf5OipZz$E.Mu'lVC:vQ)1I-fdlTNTl?0YYπU"tGCze-EDn>Qcrwp,;D&emTD)1#g*b5.c/LjS0I76M:IXr0I7Mn(j%Dbf3GG0^0,πU"6l\k4'hO>E7$A(*.olJGC:<F4eTY/?i/,E?*+HVS5B1'b2I<-+P,e,0)o'e#S0rπU"'6:D7G$.l[%Qr->G<^Mz/E:j9C+g?USA<$35vn;KxTTDymTD8VjN05s'-yr8'H^πU"fPT_4+gg:-8-Ft/OI(_N.*X;6$xE0_EAuf4PXO;(.(6S]D&:<%]x7(*&7%<=SWjπU"cr'9eQwA-*+1,$cQUC5Z9F2PP'YA<9=WLjb%PTq;Eg.j+qjQ;xMXYP1x4g+1=n\πU"1(V0PI*PgP*6'#*_%T[15Bz<p?W2.m02=UEST+1,-f'(E*$T#d*+1:;Iw9e1Q)[πU":(=Wjp]:'(*J7F)/#E;RRR01=qLjGPP,'-*uA/E;<#e9=W+jTD*L+1r//=R0E?OπU"8EeQE&-;4E_%Tn0E_O^T0E_0OT0EH_OT0=E_OTn0E_O^T0E_0NT0Eq))vu7RrwkπU")VR'7JR:Hznjpo-1mI3#M6,20L\bV:%jz-aA)h5DGc-L3r6q*,gk#zX9J'a>SXxπU"327g*u9axXj15n(IS2Y#7jbV<25==8sNbMnxu<cvq#fqNuj>z8sN9wnu9.2CXo<πU"iK>VOm8C4]kkIk>$hGmLa$AY'MP>]OKwX(nG7P?#QYrP4,ll#OXi;y/GoigckF(πU"VJaC_)ga/T_'*M;Gu,1ka,UJnvIIfF#O9*&Aj8=4i\ULb+fV#DaY)pb-;Y#gdHZπU"9dD(d<zZ6X?)?.[xy-P);+$\kZh'>+DO=k>d[0XZ?T50?#L;4JO7Ce^7:];+\jKπU"AVjBIXK\^+5djE30\*&l5ljE3i\<\jFiP6bdf>fm1Y-L*5;7P#n0]phc;=%n$(aπU"Mj,?*0$fL^+qeroWV/I7=ak\\yU9*V#I1Y,.ngYW4OAB>T6c)^o[aA;h0k&,nm2πU"/DC\.5$vkQLUYlBPoXv2dkVhHEq.mR\JTy?dH/Ipq='Dq3G3BCeMX^;Kw,C/bRBπU"Pl&5%%En*VF3^M=PL#FtPI0*,8howw?h)lN)t%$PBL3mP.U,huq4zCF/Q*)\<pAπU"4.:>y%JkCXz2z,mRmXN0$kMC\AEvs8F]]IzUqelLbe6Os(*hN6=49Ua:V=QHeDzπU"t$N?3r6mVbhhi:LIc\bnWLTdEcrSbWM):k6BcjP*?v_djA2*$r;$;fp?d%PmLkvπU"6z?%uRO;6s$P?X+]9py'(Xt^Oep7k+0WedTz,h%f3RpthC0E9MW%]AU*f\;PRXXπU"9EfFm(0k4+VHiP_Z)s8iT\Ds'6n4nsqUCMZ7%GII?cr$sqv48\=HijP5-ax$3aoπU"d6p5h.g*IM&m/>1^5Dv)K;ldLRSh?K)W4.eknM^E.RB\cf71)lk0Q_Ksugi6_J-πU";BNStS<(_xlB3,F9omJ(1-A/,uQ<5xi'N[3ToZ(J(%t5r%(h0o66bEVQ,;TKP#uπU"#O2fLQ+tdT)Dig4+LFi*(z;hX/8B8X)1]<pijK[UMXP,XKJMS_<.gfaaq_&?Jr6πU"yMlS'pt?qX$Z4G%K7M=9bSBtYF\h.qdrqk&_^A:7z*65/b9TYvtSY[t%[iH)Uj>πU"-#E2HZgkWUGWSW85]^p=?>*/2cf/oG6QD]45UXn>^qGAiPrJ^0]Upz(hEXb%pERπU"5/':pqP+XIP4_QZU)x]ky)w(Q=i93^MKMS,WjJKw;e9q0OiC0[BSP7tYX)Zv410πU"pvtaPXpIJG9/%BvmIS=z0ae.lu.*:EU]:8QNT2U*UFc#j[5*8Z%&&D8semJ5%87πU"*:pZE'FgErrf+BWh&O_a]3>5K?14;f;b,P%#5Am+fkqei>o\;nVlto=kA-OWg^ZπU"d2_fo-B)dpB=A3J8r#)>NS%M<_p;diW:l+[AA84oBQSO+rPqL#.L)1/[%:HF/.(πU"Yc*q;$r3>J)hT%(soQXE-5n7;Y3R4WSjF\2JbVhs9s,:+(uftK'GF$]oJif8)QIπU"L<McHybpdQ*SmrdtB%nP)bD^Y/rwo5)j\ZTcY$+w[tJ$lrQo0i:QDErEKOa96(sπU"fP79<d>462WdDoU]m/RE5#R$ufGC:w7+ZGa%'Y'mh4FXxX2bCR0(S6L/kPJRmB\πU"%,(7N^R\9.N=MEXp11n<[,FxX]-7Wp*D?g+E(AgU?(_C2?]ibelZ;$?4*.SzfHSπU"a:(MLzL>3c4anqYMDe?oU(0kg=efFz)AM0d4zqk7a\mhPLECNbZW]E(*jh%BAF^πU"gx3+M[#3=XgDG_sqlO&KE3LcEb43A<C3*QkF1(_NjUGJ1J'ed*YcKs6T\Ms(#HQπU"$:wd)c-WmW+^rLy=Q+UP6\j,C[Nfd/(HwAxicI+pdkI4p+IhDCI^>Lk)qZsE)mXπU"N__TG,/(.g:eN(R7avClmQ4.o#HQXx.3L5w,rmf&#Ed?=U<wX)$d=%*m3jAVOfeπU"4kI0&^bV>O^=Ow%dVF%e7_28Ok;0mNM=,5mHO3mba3O7;0c>ipl>;7Xa>)6ZX>IπU"MIIlBLeBGIp2Jsc&72/Cx:hYgGVZAY.t16PG8Z_WR.GRe1X=8**yH:+/\_<xl-9πU"cj[S^vuz$cUH?v4GvYpC_,yPD.sJNdConoacxIDJCFj;UKXrV9b\THntZMMLk%qπU"d\$m#vR(*.SS;Y,Ib,C5tOxE_I_yhBh[>lF3rp&i_-Zl5Tj;E4'\ec9iGK^JNaOπU"(ek,w\zJWI-Bj[9Kt3i=R*ST5RpATe>q^aL1O4^;eykd'oA32A.ypM-S3[WBLJBπU"7qaQ^^<BBRB4u=NqA0(<l]2.YQe8mnZ8w+7DhFjpFq^qGFjogI:vexb=;wg/<(_πU"+)iBd-3=89-t3Sa'UED.B$sum]'?.a,3a&3Qgo/sV[MX:NA34eSrdL\TBFi?cj2πU"DxY;*x%/*&>1tp3+z)MXs+$^VI6$Ug-kDnRcpSbsaE7+=RomNrs6mHEeq/>e;C2πU"<Q:A>SRm3$+Y%YeoPdCYL9-,NO_uFU^_0fbm33?%gga9xh?&Zr)SH)s&_oDq^?QπU"ad299617][*K(G)7edU?i2*?5;Erq1t?BU$^nvCWpeIBD(c-c;^r:ibns6dsSCcπU"Rw5$6nW&BBGJ6eWkt%d^:[Br\^WmN)bS&y6HT>T8qO,uf72U>BcYdur'L2:r;%.πU"8WI.PWaFNr$?^FGCxUWw=k?*/g%TSZ0-_[cEhe;Q8)\.c960314m:6bl4Tw/FKcπU"hT-FrZudLJvtNHhakh%q\\=JkM0JGNh>e%XU#+QFvbVkd^mRX_?LgE>2,$pKM75πU"+^P:g_&6,oSl^4GS)Ng3[_Z-LdAmad=]pPOWQ;jPSH0ZkQqg6=42hZFPU\F8_/yπU"hXO[#2l6Z$h3R<$lZe8roQ;_awWq24XHkey3AjXcCFtZ4k23.Bn3fuQeGlrjsvuπU"M,>s$pJ=DD:w5iKSfWFAA57Jp\-HdTHMVW<3]3d8iP[Xt6jrs$nGca7*PX8[<I4πU"[1G]LwuPh1KH',q'LM3jI,OFGaWM:pn1N;IRb?$67cZE=&=Jh]RF3)c8KUS.e;bπU"bQ.Rf>OSqp,?[o:vJKLtrf%&;Zt1NIR66ADPdW\Z=RrA56$z>?TMh/e#2X1p(CWπU"g%aD1$uHH43RO60gY4[kc2Xltr3eKDgp\Yl*8>oQDQ?Q^m7D4T:6NI:n*^]IXWHπU";AD'_c.Z41*K>_4JkDh_).[azmgTRpZ6a3eyEEC4+C]FqLL4Ve_#n&NuR46S=$=πU"IWf7'FStN\eDqNgu0rG2/9Lse;;H[XD1>]/a9l[<fW[0Xjy)>j-hHI-&*&Z2,H;πU"Xw82][50l[rkDK8Gtf_ep_Ump?y:<_LyS5^,;R>s_sHEFMa\rQIKA4PI(AQJo8SπU"9;IsLs=5i.1l6wE_5YX%f=]rDQ_vi0ozi3U/7S&'_YXr5Ul&NeBXioA\Y.qjkNOπU")HKxqRSk:IC/oq4kAiq,s4w_5YgBg7+.*vrYj.SQKfMOobpuh:E+Y^N-J0g+b&uπU"hHrux86d*t8#+6;xYl1NRTrEI<TR&D41)^?9D?B=0wf4fM%e5).0:6tdf$jLblfπU"J3ne.Fi^*9reZ(jZVRX6\nz<*2UI1yU]S'g4Jc:y'3bS/3\y00-AX9-X1P[sVPtπU"gPb2DvlDq*/KAraAF+4[9EqKoOmaKQzqYohX\\mL#p)rr8qJ1ugEJhSzNX7TTl%πU"sleGhQ?$G_I<7#noE+c68.,IpJm_9+GYsn'eAhtBAAImKX55u.E>:_tn&u$62H.πU"%D9iM.RiY,$_(E3I1A3aBE&^Np;jXrbf,f13i+YFfusu[kC9JJW_rY>;ML<&u:_πU"oF$F\N7ZUsemS[yi1TC>y#WgOU('6u:klSbS6as.nodcKHAJ4WR74<7CFmEXY4JπU"(6_iybSk/eOZO'WE2ULb&gegTJuX&wn=WP4S8fo)5k25\3Qru=?%bs^TWZVsB&eπU"YtIF[U<r=7PL;QM1%L0%fTYVm<-DygCe$uxWCbvj?>1*H#0mBhH*PXj\^cj3v,SπU"BAU0k_\[*C3RBH.yp[3n2XlYl']L_&hlysl7c%G7momR5T2e<Nd(9i)[;au/lxsπU"]4?tJ:(YEd=fTT\?6_v=0Y\F.9U8\&[r,EJQVYAfqo*:^Sgj2B^/)k2PiC<7e2qπU"7;o^):#aEgis2-,LhT5m?Ueeftl?ZkQ2VM&RH;fCJ5KGx2aEb^g\AJsxRHNe^HDπU"e9U^FfGv%:S2<H3?d/6+PzwXGcPE5\jv-vS?Z\k>#LPTKM;4U^j.5#%L2O'g7I6πU"XuCEZ)gdI6<J$>c.M55;7:n;Yuo%J'0-2i$I61\C]x(48prYwV%<Ro#KP4wNUq#πU"IrcoMc[qMV*<&3uOo8;nfsQO*DU[IDmdt)Ry=HC-;9ik2_)tkRbh(][0GHKD*MGπU"V-KYM#*#SKkiX=PZK0qJ>IVj(H9]RBX/c?r2K6OYu2;k6m8oNR_Mf+RUM2\,0SuπU"Jk_nX^OLC+e-5\4tb5XLfWHemTk^jw_G2WoZH5_Z>3_j1>2:riV0iAn1g4]c5jOπU"YGsT(:Gqu8XwD%urg:ja>Z-#s:EDc'Dc_P<+1Pfn.9H:4l$lhd*1-<D')[aA6$_πU"s,Gu5)+41BYj%Pf;D75fk,l)0a](YFEtohTT6n.aF6ZJ4&r>gwDp^.bA_-BEBTNπU"uurLT*XS^g)p^Z6&2:1G-HPiWw+B8nBZ*V2JHTChs8n3)2(#,UQJf?e\D-7KP*VπU"<qZt0in:hsVF,#BJ(80d'VB?o22?ADV%Ai<+hY,7,t^x?ZKY^^BBnW&wXG0mKdBπU"+rsWkC)Zszpu3mw[5Cu)nO:Ye)]vTIAYFumMHZfxeX)UxoB.%up()%9%%%7-%kiπU"edE/a;T]v+%%%C3%%%1%%%%rt%stmj%quSyJ'yD&;,>T]C;L<oix?6)f9]O[eEVπU"g>u/tI3W/)4DQ[9#iub7JK-.>2jS9mC-ZH(XJOnC#u,,947Lj-mBNgv>%r0z4NKπU"k#KL^bM2l)AH,Da<D7Yrh>Wu+(gK4spqk)b+USCu#>mXMHe6j+kaL]ehCE?JQhTπU"d)fI4\UkjGwBLt%jdk_oX;NI$fb7\#-BilTcomLa%rR*J_D(4vGN%0JQa$JPq0KπU"PxJpC4n$Dg<ES/R3Sj#5,FdfQOIkseD)IFC&kn;6q'R._\Keq,RRJ7H&QnqT3dOπU"DGK#&)9R3-#6ykJ(FD]GmOtYklEoY7jW&PEg]$8JSq_:-UC7<%p](:l,5P?g(/uπU"hPf5YIE+W*u-J]mq5LR9H_jZ*dSX#)1vJL3]\0%?Gg6e9*vIbV?p^9<G4A<U+D8πU">nWah2oJJP1K5:>S&RUK($>4U<(LLBP/bXp(14.;G_:1Mz7IaYU/$hC7Etv]AJ;πU"xL*aksSk&PgqrR?m_]W.SiT_=C/P^9'4S[0u\uo;FFSH_XO:3Sx/4f^w6P_'5d,πU"lS\;$Zd/4w;Do&kAq#epP3<AH[Z<NT:]^h8R]U4he+&s#bB^IXiM0X)G-R06;DdπU"$U+0PC1YixWs]U#t<^7j$ZoW#Zl4\_7J+>e9c91,3%SmbBN0jy7/tOm8%9]KC+\πU"[,ZasfhTb;v$u6E#v<JkFl2V+OP0kQ9Ae%J#0,U5bM<d)kb'rR5He;3]A\nB]RVπU"EY*$5rt7a=)R?U%mp1f0\VSlU&,AU2n>NC+W;,6\2M7u_>uLaM3GZk;[<#n]1X[πU"c>uB?>;Hse+tSK+j^B)I8H>Qtz#h9qE:AG76Gm1/wIq-WGnf\GJFrWe\3-zd_FkπU"#s)DAGwf/(rK/)95kmCsuLj-6N(\8ptiiFs\q1%&,^H]2)LUMj6C#\:3A81z4;RπU"fnc3n^Gg*>$E[Kv^mX3&md::SbBU2i9lQ>R0OF;/S_$aD0A2)-Us2)uGZ7D'SntπU"Jt^HZR/b*-jMT3GjJ7;Q_(%T6DAcMxEm0LzO_9Ug5nSJ7^Ga.%p_78Lsm/cRZPhπU"C'8=:&ZiYJo/dco^8KjJ=r9]pA1=NR.Po%8C2fXbLmk[5DnKt%JY<w*3l%LsTN1πU"n6gryE2N\d7\e0bj$*L<l[VEv??ZpG-.^Cjk/y>HKL_E_dl;\Zcm]5[C.A0>W&UπU",_C#Qo2n&TyT*F-tTX]*?q^>>86S[gy:9%NVGT,F?^n)Q,ftS1.qS1C%L-%r[1DπU"CR1M'&k%c9J?T*C(Vc+Lr$(1tb4*4C7<hinXc,ft][UrN,X&jR1S7BF^VR81edzπU"wBCK8ha>_02D*hIB1e;vSwjAu23q]=MwaWHw<#1ZS5ER^GTJxLxWK_A<YPwIk8UπU"tmJu<O'8<DJKfwfPd+WWovM:G->cbd/aAQ-5q5pISp>h/o_LdI25V'0--NQk&#UπU"vS:t*F2iBg/C]obtX;;ZIaN>;p1w:%PVt/%w5RIpp7OHcu+TiE.LJp#QodpcFp4πU",1giP?Om&ZD.K%$NwAcEjL7\trbwb+#]uaGba\.6+UN_<Kdr%_qSSm3YJwpj;I:πU"PJBLDE1ukT8mQfh&4tHtGi;gWMayaVaGI]MJ6c$Y2Bgo]^2s4F(ZM1Zh^J]JEqkπU"ywnH);sg//5m.TCy+jjEF%/td*1=X#2e0I>f+p1]oAJw;-k72P\a-PT<jbb4m^mπU"h\A,e?68q:xk6Ce$8G:$uN.,;-tsUM[sp_4QtUphjwm-m^O%pKe%$ihXamdhNVuπU"\'Ac[+[?yB:V9HCHgoeU;\_7G=M6;WpeZ;OP.R<WYGpKom42Fm0<6Z,,tf$QxHcπU"01Mi/'fLiF9,9EVIZJ;gemYSlTC^6uw8bQ22H-)hdDCpcL[peH^h:GYoaKJ'SuZπU"HF0G[ilH%w;M&'\g*cjb=]Hw_Y9<aRc*t\86vs-=dZK#(g'S3oem%L?KV3uUf$NπU"1fd6knPrLN776Q8$RWEJUrN^#EsiF.WLqeX;xf;w?lolU[0d^n^oZ;C4F3h/CdfπU"2Tt4jN8*hk36M=WfjDJnXr23V*e)+nKNZT]c&C$^Pgt7be)Sh,%dr^4([#4>rTNπU"HVK+u-lG'WI-SM):(C+H2S[?jvl)nJ?m$;O1]*kt/,6;O&hBpHdqw=;<?tGC;b8πU"<>9-2X)LqARg%0RO;BX=wHRISril4gZ?5K_,NGFKC>m70]3)cei-&uM6#I8h3KnπU"I4AB^*?y?C,H-K^VOe*W(XHMXkHOGXW6LnyIVR]bOy(aZHZs_S=]#b6U:L:csTxπU"$X-Wx%u%p()9%%%%-#%Pjd7E?&4%g;%%+%;&%%%1%%%%rts%tutq&(Sxf>%f9V%πU"&%%%GQ)O3(UN^P)?I];,TL/u%p&'9%%9%%#%-%TCidE2hreE;[e%%=&Y&%1%%%%πU"%%%%%&%%E%%%%%%%%%rts%tutq&(Sgf%xup&%'9%9%%%%-F%kidUE/aT,]v+%%%πU"C3%%%1%%%%%%%%%&%E[%%%e%e%%r%tstm%jquS(y'yu%p&'9%%9%%%%-%P(jdE?πU"'&4g;[%%%;%&%%1%%%%%%%%%&%%E%%%%8m%%%rts%tutq&(Sxf&%up*%+%%%%%(πU"%(+%'%%%%xm%%%%%πEND SUBπV2πCLOSE:IF S=162AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπAkarsha Vasant Kumar           QBASIC PCMAN                   [e-mail]   07-07-96 (00:14)       QB, QBasic, PDS        539  18490    PCMAN.BAS   '--------------------------------------------------------------------------π'|||||||||||||                QBASIC  PCMAN              ||||||||||||||||||π'--------------------------------------------------------------------------π'                       --- Akarsha V. Kumarππ'HI !! I'm a high school student and I waste a lotta time programming inπ'Qbasic ( My mom doesn't like it one bit tho !!)π'I haven't really completed this game . You can go ahead and completeπ'it. I have used the screen function to find which charachter is printedπ'at a specific point .This greatly reduces the program size and speedπ'as one does not require to feed in the maze data into an array .π'The mazes are printed at the bottom of the program and you can make yourπ'own mazes as I have done by simply typing in the designs .π'The program should work on any maze provided to it .Don't blame me if it dosen't !!π'The program also includes a subroutine for drawing bordered boxes .π'The monsters are not very smart and are absolutely incapableπ'of chasing MR.PCMAN very well .Moreover , the monsters delete the numbersπ'while moving over them . You can make the necessary additions .π'I'm too LAZY !!π'NOTE : The program may crawl on slow computers . Try compiling it .π'       Better still , change the delay timesππDECLARE SUB DRAWDBLBOX (X1, Y1, X2, Y2)ππTIMER ONπRANDOMIZE TIMERπLEVEL = 1πSCREEN 0, , 1ππFOR I = 1 TO 5πCLSπCALL DRAWDBLBOX(40 - 7 * I, 10 - I, 40 + 7 * I, 12 + I)πSTARTIME = TIMERπDOπTIME = TIMERπLOOP UNTIL TIME - STARTIME > .05ππNEXT Iππ LOCATE 8, 18: PRINT "░░░░░░   ░░░░░░   ░░░   ░░░  ░░░░░░░   ░░░    ░  "π LOCATE 9, 18: PRINT "░    ░   ░        ░  ░ ░  ░  ░     ░   ░  ░   ░  "πLOCATE 10, 18: PRINT "▒▒▒▒▒▒   ▒        ▒   ▒   ▒  ▒▒▒▒▒▒▒   ▒   ▒  ▒  "πLOCATE 11, 18: PRINT "▒        ▒        ▒       ▒  ▒     ▒   ▒    ▒ ▒  "πLOCATE 12, 18: PRINT "▓        ▓        ▓       ▓  ▓     ▓   ▓     ▓▓  "πLOCATE 13, 18: PRINT "▓        ▓▓▓▓▓▓   ▓       ▓  ▓     ▓   ▓      ▓  "ππLOCATE 15, 27: PRINT "PROGRAMMED BY : AKARSHA V. KUMAR"ππLOCATE 22, 35: PRINT "PRESS A KEY ...."πDO: LOOP UNTIL INPUT$(1) <> ""ππFOR I = 1 TO 5πCLSπCALL DRAWDBLBOX(40 - 3 * I, 10 - I, 45 + 3 * I, 15 + I)πSTARTIME = TIMERπDOπTIME = TIMERπLOOP UNTIL TIME - STARTIME > .05ππNEXT IππLOCATE 8, 29: PRINT " USE THE FOLLOWING KEYS ...."πLOCATE 10, 42: PRINT CHR$(24)πLOCATE 11, 40: PRINT CHR$(27); SPC(3); CHR$(26)πLOCATE 12, 42: PRINT CHR$(25)πLOCATE 14, 37: PRINT "S ==> SHOOT "πLOCATE 15, 37: PRINT "Q ==> QUIT"πLOCATE 17, 35: COLOR 10, 0: PRINT "(+) ==> PACMAN": COLOR 2, 0πLOCATE 18, 35: PRINT "[-] ==> MONSTERS"πDO: LOOP UNTIL INPUT$(1) <> ""π1 LIFE = 5ππCLSππ'declarationsπDIM MONSTERROWπDIM MONSTERCOLπDIM MONSTERORIENT$πDIM DIRππ'determine which maze to drawπIF LEVEL = 1 THEN MONSTEREDRAW = 0: direction$ = "": GOSUB 9999πIF LEVEL = 2 THEN MONSTEREDRAW = 0: direction$ = "": GOSUB 9998πIF LEVEL = 3 THEN MONSTEREDRAW = 0: direction$ = "": GOSUB 9997πIF LEVEL > 3 THEN MONSTEREDRAW = 0: direction$ = "": GOSUB VICTORYππSCORE = 1ππLOCATE 22, 25: PRINT "LEVEL "; LEVELπDO: LOOP UNTIL INPUT$(1) <> ""ππSHOT = NUMMONST * 3ππFOR I = 1 TO NUMMONSTπDIR(I) = INT(RND * 3) + 1πMONSTERPOS(I) = 1πNEXT IππSTART:ππ'redraw maze if all monsters are shotπIF MONSTEREDRAW = 1 AND LEVEL = 1 THEN GOSUB 9999πIF MONSTEREDRAW = 1 AND LEVEL = 2 THEN GOSUB 9998πIF MONSTEREDRAW = 1 AND LEVEL = 3 THEN GOSUB 9997ππLOCATE PCMANROW, PCMANCOLπPRINT "   "ππK$ = INKEY$πIF K$ = CHR$(0) + "H" THEN GOSUB UPπIF K$ = CHR$(0) + "P" THEN GOSUB DOWNπIF K$ = CHR$(0) + "K" THEN GOSUB LEFTπIF K$ = CHR$(0) + "M" THEN GOSUB RIGHTπIF UCASE$(K$) = "S" THEN GOSUB SHOOTπIF UCASE$(K$) = "Q" THEN GOSUB QUITππIF direction$ = "LEFT" THEN PCMANCOL = PCMANCOL - 1πIF direction$ = "RIGHT" THEN PCMANCOL = PCMANCOL + 1πIF direction$ = "UP" THEN PCMANROW = PCMANROW - 1πIF direction$ = "DOWN" THEN PCMANROW = PCMANROW + 1ππIF PCMANROW <= 1 THEN PCMANROW = 19πIF PCMANROW >= 20 THEN PCMANROW = 2πIF PCMANCOL <= 1 THEN PCMANCOL = 57πIF PCMANCOL >= 58 THEN PCMANCOL = 1ππ'check if pcman hits the wallsπFOR X = 0 TO 2πA = SCREEN(PCMANROW, PCMANCOL + X)πIF CHR$(A) = "#" THEN SOUND (150), 1: GOSUB CHANGEDIRπNEXT Xππ'check if pcman hits numbersπFOR X = 0 TO 2πB = SCREEN(PCMANROW, PCMANCOL + X)πIF VAL(CHR$(B)) < 10 AND VAL(CHR$(B)) > 0 THEN SOUND (300), 1: NOOFFRUITS = NOOFFRUITS - 1: SCORE = SCORE + VAL(CHR$(B))πNEXT XππGOSUB DRAWMONSTππIF LIFE <= 0 THEN : FOR Y = 10 TO 14: FOR X = 25 TO 44: LOCATE Y, X: PRINT CHR$(178): NEXT X: NEXT Y: LOCATE 12, 31: PRINT "GAME OVER": SLEEP (2): CLS : SYSTEMππIF SCORE > 200 THEN LEVEL = LEVEL + 1: GOTO 1ππCOLOR 10, 8πLOCATE PCMANROW, PCMANCOLπPRINT "(+)"πCOLOR 2, 0ππLOCATE 23, 1, 0, 0πPRINT "LIVES :"; LIFEπLOCATE 23, 20πPRINT "BULLETS :"; SHOTπLOCATE 23, 40πPRINT "SCORE :"; SCOREππGOTO STARTππENDππ'change direction if pcman hits wallπCHANGEDIR:πIF direction$ = "LEFT" THEN PCMANCOL = PCMANCOL + 1: direction$ = "RIGHT": RETURNπIF direction$ = "RIGHT" THEN PCMANCOL = PCMANCOL - 1: direction$ = "LEFT": RETURNπIF direction$ = "UP" THEN PCMANROW = PCMANROW + 1: direction$ = "DOWN": RETURNπIF direction$ = "DOWN" THEN PCMANROW = PCMANROW - 1: direction$ = "UP": RETURNπRETURNππLEFT:πA = SCREEN(PCMANROW, PCMANCOL - 1)πIF CHR$(A) = "#" THEN RETURNπdirection$ = "LEFT"πRETURNππRIGHT:πA = SCREEN(PCMANROW, PCMANCOL + 3)πIF CHR$(A) = "#" THEN RETURNπdirection$ = "RIGHT"πRETURNππUP:πIF PCMANROW = 1 THEN RETURNπFOR X = 0 TO 2πA = SCREEN(PCMANROW - 1, PCMANCOL + X)πIF CHR$(A) = "#" THEN RETURNπNEXT Xπdirection$ = "UP"πRETURNππDOWN:πFOR X = 0 TO 2πA = SCREEN(PCMANROW + 1, PCMANCOL + X)πIF CHR$(A) = "#" THEN RETURNπNEXT Xπdirection$ = "DOWN"πRETURNππ'subroutine for shooting bulletsπSHOOT:ππIF SHOT = 0 OR PCMANROW = 1 OR PCMANCOL = 1 THEN RETURNππSHOT = SHOT - 1πCOLOR 10, 0πI = 1π'check for walls around pcman and draw bulletsπ170 IF direction$ = "LEFT" THEN A = PCMANROW: B = PCMANCOL - I: C = SCREEN(A, B): IF CHR$(C) = "#" THEN SOUND (100), 1: RETURN:  ELSE LOCATE PCMANROW, PCMANCOL - I: PRINT CHR$(27)πIF direction$ = "RIGHT" THEN A = PCMANROW: B = PCMANCOL + 3 + I: C = SCREEN(A, B): IF CHR$(C) = "#" THEN SOUND (100), 1: RETURN:  ELSE LOCATE PCMANROW, PCMANCOL + 3 + I: PRINT CHR$(26)πIF direction$ = "UP" THEN A = PCMANROW - I: B = PCMANCOL + 1: C = SCREEN(A, B): IF CHR$(C) = "#" THEN SOUND (100), 1: RETURN:  ELSE LOCATE PCMANROW - I, PCMANCOL + 1: PRINT CHR$(24)πIF direction$ = "DOWN" THEN A = PCMANROW + I: B = PCMANCOL + 1: C = SCREEN(A, B): IF CHR$(C) = "#" THEN SOUND (100), 1: RETURN:  ELSE LOCATE PCMANROW + I, PCMANCOL + 1: PRINT CHR$(25)πLOCATE PCMANROW, PCMANCOL: PRINT "(+)"ππFOR DELAY = 1 TO 200: NEXT DELAYππIF direction$ = "LEFT" THEN LOCATE PCMANROW, PCMANCOL - IπIF direction$ = "RIGHT" THEN LOCATE PCMANROW, PCMANCOL + 3 + IπIF direction$ = "UP" THEN LOCATE PCMANROW - I, PCMANCOL + 1πIF direction$ = "DOWN" THEN LOCATE PCMANROW + I, PCMANCOL + 1πPRINT " "πLOCATE PCMANROW, PCMANCOL: PRINT "   "ππ'return if bullet goes out of maze limitsπIF A >= 20 OR A < 2 THEN RETURNπIF B >= 60 OR B < 2 THEN RETURNππ'check whether bullet hits monsterπFOR X = 1 TO NUMMONSTπIF MONSTERPOS(X) = 1 AND B >= MONSTERCOL(X) AND B < MONSTERCOL(X) + 3 AND A = MONSTERROW(X) THEN PLAY "CFC": MONSTERPOS(X) = 0: LOCATE MONSTERROW(X), MONSTERCOL(X): PRINT "   ": SCORE = SCORE + 50: RETURNπNEXT XπI = I + 1: GOTO 170ππRETURNππDRAWMONST:ππ'draw pcmanπCOLOR 10, 8πLOCATE PCMANROW, PCMANCOLπPRINT "(+)"πCOLOR 2, 0ππ'erase monsterπFOR I = 1 TO NUMMONSTπIF MONSTERPOS(I) = 0 THEN GOTO 5πLOCATE MONSTERROW(I), MONSTERCOL(I): PRINT "   "π5 NEXT Iππ' if monster moves out of maze , produce it at the other endπFOR I = 1 TO NUMMONSTπIF MONSTERPOS(I) = 0 THEN GOTO 20πIF MONSTERCOL(I) <= 1 THEN MONSTERCOL(I) = 55πIF MONSTERCOL(I) >= 57 THEN MONSTERCOL(I) = 2πIF MONSTERROW(I) <= 1 THEN MONSTERROW(I) = 19πIF MONSTERROW(I) >= 20 THEN MONSTERROW(I) = 2ππ' check if pcman touches monsterπIF PCMANCOL > MONSTERCOL(I) - 3 AND PCMANCOL < MONSTERCOL(I) + 3 AND PCMANROW = MONSTERROW(I) THEN PLAY "EC": LOCATE PCMANROW, PCMANCOL: PRINT " ": LIFE = LIFE - 1: PCMANROW = YY: PCMANCOL = XX: SCORE = SCORE - 50: RETURNππ'This routine checks for walls and changes monster directionπ'Have to develop a better logic for this part.πSELECT CASE DIR(I)ππCASE 1ππFOR X = 0 TO 2πA = SCREEN(MONSTERROW(I) + 1, MONSTERCOL(I) + X)πIF CHR$(A) = "#" THEN GOTO 10πNEXT XπMONSTERROW(I) = MONSTERROW(I) + 1: GOTO 20π10 A = SCREEN(MONSTERROW(I), MONSTERCOL(I) - 1)πIF CHR$(A) <> "#" THEN MONSTERCOL(I) = MONSTERCOL(I) - 1 ELSE DIR(I) = 4ππCASE 2ππFOR X = 0 TO 2πA = SCREEN(MONSTERROW(I) - 1, MONSTERCOL(I) + X)πIF CHR$(A) = "#" THEN GOTO 30πNEXT XπMONSTERROW(I) = MONSTERROW(I) - 1: GOTO 20π30 A = SCREEN(MONSTERROW(I), MONSTERCOL(I) + 3)πIF CHR$(A) <> "#" THEN MONSTERCOL(I) = MONSTERCOL(I) + 1 ELSE DIR(I) = 3ππCASE 3πA = SCREEN(MONSTERROW(I), MONSTERCOL(I) - 1)πIF CHR$(A) <> "#" THEN MONSTERCOL(I) = MONSTERCOL(I) - 1: GOTO 20πFOR X = 0 TO 2πA = SCREEN(MONSTERROW(I) - 1, MONSTERCOL(I))πIF CHR$(A) = "#" THEN DIR(I) = 1: GOTO 20πNEXT XπMONSTERROW(I) = MONSTERROW(I) - 1ππCASE 4πA = SCREEN(MONSTERROW(I), MONSTERCOL(I) + 3)πIF CHR$(A) <> "#" THEN MONSTERCOL(I) = MONSTERCOL(I) + 1: GOTO 20πFOR X = 0 TO 2πA = SCREEN(MONSTERROW(I) + 1, MONSTERCOL(I))πIF CHR$(A) = "#" THEN DIR(I) = 2: GOTO 20πNEXT XπMONSTERROW(I) = MONSTERROW(I) + 1ππEND SELECTππ20 NEXT Iππ'Draw monstersπFOR I = 1 TO NUMMONSTπIF MONSTERPOS(I) = 0 THEN GOTO 60πCOLOR 10, 2πLOCATE MONSTERROW(I), MONSTERCOL(I)πPRINT "[-]"πCOLOR 2, 0π60 NEXT Iππ' Check if all monsters are deadπFOR I = 1 TO NUMMONSTπIF MONSTERPOS(I) <> 0 THEN GOTO 100πNEXT IπMONSTEREDRAW = 1πFOR I = 1 TO NUMMONSTπMONSTERPOS(I) = 1πNEXT Iππ100 STARTIME = TIMERπDOπTIME = TIMERπLOOP UNTIL TIME - STARTIME > .1ππRETURNπ                                    πVICTORY:πCLSπ LOCATE 8, 8: PRINT "█     █      ██      █     █      █       █      █    ███     █"π LOCATE 9, 8: PRINT " █   █     ██  ██    █     █      █       █      █    ██ █    █"πLOCATE 10, 8: PRINT "  ███     █      █   █     █      █       █      █    ██  █   █"πLOCATE 11, 8: PRINT "   █      █      █   █     █      █   █   █      █    ██   █  █"πLOCATE 12, 8: PRINT "   █       ██  ██    █     █       █  █  █       █    ██    █ █"πLOCATE 13, 8: PRINT "   █         ██      ███████        ██ ██        █    ██     ██"ππLOCATE 22, 35: PRINT "SCORE :"; SCOREπPLAY "O2 L5CL8DE-P14FL4G>P10 C P14 <L5A-L7B->CP14<L4G P8 L8FE-P14DL4C"πSYSTEMππQUIT:πLOCATE 23, 1: PRINT "                                                       "πPCOPY 1, 2πFOR Y = 10 TO 14πFOR X = 20 TO 39πLOCATE Y, X: PRINT CHR$(177)πNEXT XπNEXT YπLOCATE 12, 23: INPUT "QUIT ?(Y/N):", ANS$: ANS$ = UCASE$(ANS$)πIF ANS$ = "Y" THENπLOCATE 1, 1: FOR X = 1 TO 80:  FOR Y = 1 TO 23: LOCATE Y, X: PRINT " "; : NEXT Y: NEXT XπCLSπCALL DRAWDBLBOX(15, 5, 69, 17)πLOCATE 7, 17: PRINT "This incomplete game has been written in QuickBasic"πLOCATE 8, 22: PRINT "You are free to distribute it as you like."πLOCATE 9, 22: PRINT "  Suggestions on how to make those stupid "πLOCATE 10, 18: PRINT "monsters move more sensibly are ever welcome !!!"πLOCATE 12, 28: PRINT "Do send in comments at:"πLOCATE 13, 27: PRINT "[e-mail]"ππLOCATE 15, 30: PRINT "Thanks for playing..."πDO: LOOP UNTIL INKEY$ <> ""ππSYSTEMπEND IFππLOCATE 23, 1: PRINT "                                                       "πPCOPY 2, 1πSCREEN 0, , 1πRETURNππ' These sub-routines contain the data for drawing mazes as well as monsterπ' and pcman init positions . You can add your own mazes . If you want toπ' increase or decrease maze size , some minor changes have to be made toπ' the prog. parts which check if monsters.etc have strayed out of the maze .π' Try to follow a similar pattern while making the mazes .ππ9999πSHOT = NUMMONSTπ    LOCATE 1, 1, 1π    NUMMONST = 3π    NOOFFRUITS = 20π    COLOR 2, 0π    PRINT "##############################################   ###########"π    PRINT "#### 4 ######## 4         5      #############   ###########"π    PRINT "####   ########   ############################   ###########"π    PRINT "####   ########   #######                      1          ##"π    PRINT "####   ########   #######   ##################   ####   ####"π    PRINT "#### 9          4         5 ##################   ####   ####"π    PRINT "#########   ###################### 9 ################   ####"π    PRINT "#########   ######################   ############# 2      ##"π    PRINT "#########   ######################   ################   ####"π    PRINT "######### 9                #######   #############        ##"π    PRINT "#########   ############ 5 #######   #############   ##   ##"π    PRINT "## 7   ##   ############             #############   ##   ##"π    PRINT "####   ##   ############   ##############            ##   ##"π    PRINT "####   ## 9       ######   #######################   ##   ##"π    PRINT "####   ##   ###   ######   #######################   ## 2 ##"π    PRINT "####   ##   ######################################   #######"π    PRINT "     5                   4                         1        "π    PRINT "####   ####   ################################   #   #######"π    PRINT "## 8   ####           9           ############   #    2  ###"π    PRINT "##############################################   ###########"π      πFOR I = 1 TO 3π140 MONSTERROW(I) = INT(RND * 20) + 1πMONSTERCOL(I) = INT(RND * 56) + 1πFOR X = 0 TO 2πIF SCREEN(MONSTERROW(I), MONSTERCOL(I) + X) = 35 THEN GOTO 140πNEXT XπNEXT Iπ      π    IF MONSTEREDRAW = 1 THEN MONSTEREDRAW = 0: RETURNπ    LET PCMANROW = 20: YY = 20π    LET PCMANCOL = 47: XX = 47π110 RETURNππREM ----------------------------------------------------------------------ππ9998   SHOT = NUMMONSTπ    πNUMMONST = 4πNOOFFRUITS = 38πLOCATE 1, 1, 1πCOLOR 2, 0πPRINT "###   ##########################   #########################"πPRINT "###   ##########################   # 9  4    ###############"πPRINT "###   ######        6         1    #   ###   ###############"πPRINT "### 1 ###### 3 ##########   ######## 9 ###     9  1     8 ##"πPRINT "###   ######   ########## 4 ########   ###   ########   ####"πPRINT "###    7       ##########   ##############   ######## 3 ####"πPRINT "############   ##########   ####   #######   ########   ####"πPRINT "############ 2 ##   8       #### 5 #######    8   2     ####"πPRINT "###   ######   ##   ############   #######   ########   ####"πPRINT "### 1 ######   ## 9 ############   ####### 7 ######## 5 ####"πPRINT "###   ######   ##   ############   #######   ########   ####"πPRINT "      ###### 5 #################     6                      "πPRINT "###   ######   #################   #####   #####   ###   ###"πPRINT "###                   4            ##### 8 ##### 3 ###   ###"πPRINT "### 2 ########################## 3 #####   #####   ### 4 ###"πPRINT "###   ##########################      7            ###   ###"πPRINT "###             8       ########   #############   ###   ###"πPRINT "###   #### 6 ######## 9       4    ############# 3       ###"πPRINT "### 3 ####   ################### 1 #########################"πPRINT "###   ##########################   #########################"πFOR I = 1 TO 4π150 MONSTERROW(I) = INT(RND * 20) + 1πMONSTERCOL(I) = INT(RND * 56) + 1πFOR X = 0 TO 2πIF SCREEN(MONSTERROW(I), MONSTERCOL(I) + X) = 35 THEN GOTO 150πNEXT XπNEXT Iπ    IF MONSTEREDRAW = 1 THEN MONSTEREDRAW = 0: RETURNπ    LET PCMANROW = 3: YY = 3π    LET PCMANCOL = 4: XX = 4π    π120 RETURNππREM ---------------------------------------------------------ππ9997    SHOT = NUMMONSTπ    LOCATE 1, 1, 1π    πNUMMONST = 5πNOOFFRUITS = 37πCOLOR 2, 0πPRINT "######   ######################################   ##########"πPRINT "######   ###################################### 1 ##########"πPRINT "###### 6 ####### 9 ################## 2 #######       9 ####"πPRINT "### 7    #######           2            #######   ###   ####"πPRINT "###      #######   ## 9 ######## 9 ##   #######       4 ####"πPRINT "######   ####### 3 ##   ########   ##   #######   ##########"πPRINT "###### 8 #######   ################## 5 ####### 3 ##########"πPRINT "######      1         6    ##   6           7     ##########"πPRINT "##############   ######################   ##################"πPRINT "##############   ######################   ##################"πPRINT "    4    7            9  ######## 9             4     1     "πPRINT "##############   ######################   ##################"πPRINT "############## 4 ######################   ##################"πPRINT "###### 1              5          5                ##########"πPRINT "######   ##################   #################   ##########"πPRINT "###            6     8             8     6        ##########"πPRINT "### 3    ################## 7 #################       4 ####"πPRINT "######   ##################   #################   ###   ####"πPRINT "###### 1 ######################################       9 ####"πPRINT "######   ######################################   ##########"πFOR I = 1 TO 5π160 MONSTERROW(I) = INT(RND * 20) + 1πMONSTERCOL(I) = INT(RND * 56) + 1πFOR X = 0 TO 2πIF SCREEN(MONSTERROW(I), MONSTERCOL(I) + X) = 35 THEN GOTO 160πNEXT XπNEXT Iπ    IF MONSTEREDRAW = 1 THEN MONSTEREDRAW = 0: RETURNπ    LET PCMANROW = 1: YY = 1π    LET PCMANCOL = 7: XX = 7π    π130 RETURNππSUB DRAWDBLBOX (X1, Y1, X2, Y2)ππ'CHECK FOR VALID CO-ORDINATESπIF X1 > 80 OR X1 < 1 OR X2 > 80 OR X2 < 1 OR Y1 > 24 OR Y1 < 1 OR Y2 > 24 OR Y2 < 1 THEN GOTO 101ππIF X1 > X2 THEN ' DETERMINE GREATER CO-ORDINATEπGREATERX = X1: LESSERX = X2πELSEπGREATERX = X2: LESSERX = X1πEND IFππ'DRAW HORIZONTAL LINESπFOR I = (LESSERX + 1) TO (GREATERX - 1)πLOCATE Y1, I: PRINT CHR$(205)πLOCATE Y2, I: PRINT CHR$(205)πNEXT Iππ'DRAW VERTICAL LINESππIF Y1 > Y2 THEN ' DETERMINE GREATER CO-ORDINATEπGREATERY = Y1: LESSERY = Y2πELSEπGREATERY = Y2: LESSERY = Y1πEND IFππFOR I = LESSERY + 1 TO GREATERY - 1πLOCATE I, X1: PRINT CHR$(186)πLOCATE I, X2: PRINT CHR$(186)πNEXT Iππ'DRAW CORNERSπLOCATE LESSERY, LESSERX: PRINT CHR$(201)πLOCATE GREATERY, GREATERX: PRINT CHR$(188)πLOCATE LESSERY, GREATERX: PRINT CHR$(187)πLOCATE GREATERY, LESSERX: PRINT CHR$(200)ππ101 END SUBππAkarsha Vasant Kumar           QBASIC ROAD RACER              [e-mail]   07-07-96 (00:16)       QB, QBasic, PDS        338  9873     ROADRACE.BAS'        ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░π'        ░░░░░░░░░            Qbasic Roadrace          ░░░░░░░░░░π'        ░░░░░░░░░░░░░░░░-   Akarsha V. Kumar░░░░░░░░░░░░░░░░░░░░ππ'Namaste ! That's Indian for HI !! I'm a high school dude and I waste lottsaπ'time programming in QBASIC ( My mom doesn't like it one bit tho !!)π'This was one of the first games I wrote and it works pretty neatly althoπ'the code has been written in a very haphazard manner (I was very new then).π'I have absolutely no idea about how it will look in color (We in India findπ'it difficult ..sob ...to afford even a mono monitor ...Boo Hoo Hoo .....).π'So please sympathise 'n do something about the color attributes I've setπ'if you get wierd combinations like pink 'n orange ( Har Har ....)π'So all you Sennas out there ...... get set and go !π'Happy playing !!!ππ'NOTE : Runs fastest when compiledππRANDOMIZE TIMERπTIMER ONπSCREEN 1: CLSππCIRCLE (165, 85), 50, 1: PAINT (165, 85), 1πCIRCLE (160, 80), 50, 2: PAINT (160, 80), 2πLOCATE 10, 16: PRINT "ROAD RACER": SLEEP (2): CLSππLOCATE 10, 14: PRINT "PROGRAM BY :"ππFOR X = 2 TO 13πLOCATE 12, X - 1: PRINT "             "πLOCATE 12, X: PRINT "AKARSHA KUMAR"πSTARTIME = TIMERπDOπtime = TIMERπLOOP UNTIL time - STARTIME > .1ππNEXT XππFOR Y = 20 TO 14 STEP -1πLOCATE Y + 1, 11: PRINT "                     "πLOCATE Y, 11: PRINT "D.G.RUPAREL COLLEGE"πSTARTIME = TIMERπDOπtime = TIMERπLOOP UNTIL time - STARTIME > .1ππNEXT YππLINE (50, 50)-(250, 140), 1, BπSLEEP (1): CLSπDOπPRINT "USE THE FOLLOWING KEYS:"πPRINT : PRINTπPRINT "  LEFT AND RIGHT ARROW KEYS TO MOVE"πPRINTπPRINT "  F1 TO ACCELERATE AND F2 TO DECELERATE"πPRINTπPRINT "  Q TO QUIT ."πLOCATE 15, 5: PRINT "PRESS A KEY"πLOOP UNTIL INPUT$(1) <> ""πCLSππ'Init variablesπ1 X = 0: Y = 10: Z = 190: A = 150: B = 195: I = 1: : SOUNDLEVEL = 1000πSTARTTIME = INT(TIMER)ππCAR$ = "U20 E3 R7 F3 D20 L12 E2 U15 H2 F2 R7 E2 G2 D15 F2 H2 L7"ππDOππCARX = A: CARY = -50πI = (RND * 4) - 2ππLOCATE 1, 31: PRINT "Time": LOCATE 1, 36: PRINT "Kms"πLOCATE 14, 1: PRINT "Speed "ππ10      LINE (100, 0)-(100, 200), 1: LINE (220, 0)-(220, 200), 1π'Get inputsπK$ = INKEY$πIF K$ = CHR$(0) + "K" THEN GOSUB LEFTπIF K$ = CHR$(0) + "M" THEN GOSUB RIGHTπIF UCASE$(K$) = "Q" THEN GOSUB PLAYAGAINπON KEY(1) GOSUB SPEEDUPπON KEY(2) GOSUB SPEEDDOWNππ'Time graphπLINE (240, 10)-(260, 190), 1, BπLINE (240, 190 - TIMETAKEN * 9 / 10)-(260, 190), 2, BFππ'Distance graphπLINE (280, 10)-(300, 190), 2, BπLINE (280, 190 - (DISTANCE / 1000) * 5 * 9 / 10)-(300, 190), 1, BFππ'SpeedometerπLINE (50, 50)-(75, 200), 1, BFπLINE (50, 200 - SPEED * 10)-(75, 200 - SPEED * 10), 2ππIF CARY > 200 THEN GOTO 20 'Check if obstacle car has moved out of screenππIF SPEED = 0 THEN CARY = CARY - 3 ' If your speed=0 then move obstacle in opp. directionππKEY(1) ON: KEY(2) ONππLINE (95, X)-(100, X - 95), 1, BF         ' --πLINE (95, Y)-(100, Y - 5), 1, BF          '   |πLINE (95, Z)-(100, Z - 95), 1, BF         '   |__ Draw side linesπ                                          '   |πLINE (220, X)-(225, X - 95), 1, BF        '   |πLINE (220, Y)-(225, Y - 10), 1, BF        ' --πLINE (220, Z)-(225, Z - 95), 1, BF        'ππ'Draw FinishlineπIF FINISH$ = "WIN" THEN LINE (100, FINISHLINE)-(220, FINISHLINE + 10), 2, BFπPSET (A, 195)πDRAW CAR$ππLINE (CARX, CARY)-(CARX + 20, CARY + 35), 1, BF: LINE (CARX + 5, CARY + 10)-(CARX + 15, CARY + 30), 2, BFπLINE (CARX + 5, CARY + 7)-(CARX + 15, CARY + 10), 0, BFππSTARTIME = TIMERπDOπtime = TIMERπLOOP UNTIL time - STARTIME > .01ππLOCATE 1, 1: PRINT "Speed :"; INT(SPEED * 10)πLOCATE 2, 1: PRINT "Crashes :"; CRASHπLOCATE 3, 1: PRINT "Kms :"; 40 - INT(DISTANCE / 1000)πLOCATE 4, 1: PRINT "Time :"; 200 - TIMETAKENππSOUND (SOUNDLEVEL), .03 ' create that irritating noiseππLINE (95, X)-(100, X - 95), 0, BFπLINE (95, Y)-(100, Y - 5), 0, BFπLINE (95, Z)-(100, Z - 95), 0, BFππLINE (220, X)-(225, X - 95), 0, BFπLINE (220, Y)-(225, Y - 10), 0, BFπLINE (220, Z)-(225, Z - 95), 0, BFππIF Z > 240 THEN Z = 0  'πIF Y > 240 THEN Y = 0  ' Check if sidelines move outπIF X > 240 THEN X = 0  'πππX = X + SPEED: Y = Y + SPEED: Z = Z + SPEEDππLINE (A + 5, 175)-(A + 15, 195), 0, BF ' erase carππ'Erase obstacleπLINE (CARX, CARY)-(CARX + 20, CARY + 35), 0, BF: LINE (CARX + 5, CARY + 10)-(CARX + 15, CARY + 30), 0, BFπLINE (CARX + 5, CARY + 7)-(CARX + 15, CARY + 10), 0, BFππ'Erase FinishlineπIF FINISH$ = "WIN" THEN LINE (100, FINISHLINE)-(220, FINISHLINE + 10), 0, BFππDISTANCE = DISTANCE + SPEEDπSYSTEMTIME = INT(TIMER)πTIMETAKEN = SYSTEMTIME - STARTTIMEπCARY = CARY + SPEED / 2πCARX = CARX + IπIF FINISH$ = "WIN" THEN FINISHLINE = FINISHLINE + SPEEDπIF 200 - TIMETAKEN = 0 THEN LOCATE 11, 16: PRINT "TIME UP": BEEP: SLEEP (2): : STATUS$ = "LOSE": GOSUB PLAYAGAINπIF FINISHLINE >= 170 THEN LOCATE 11, 13: GOSUB VICTORYπIF 40 - INT(DISTANCE / 1000) <= 0 THEN : FINISH$ = "WIN"πIF CARX > 190 OR CARX < 100 THEN I = I * -1πIF CARY = 190 THEN GOTO 20πIF CARY > 135 AND CARY < 195 AND CARX >= A - 25 AND CARX <= A + 15 THEN SOUND (190), 1: GOSUB CARCRASH: CRASH = CRASH + 1:  ELSE GOTO 10ππ20 LOOP UNTIL CRASH = 10πLOCATE 11, 13: PRINT "CAR DAMAGED !": BEEP: SLEEP (2): : STATUS$ = "LOSE": GOSUB PLAYAGAINππ'Routines to move car ; decrease & increase speedsππLEFT:πIF A = 100 THEN RETURNπLINE (A - 2, 197)-(A + 17, 160), 0, BFπA = A - 10πPSET (A, 195): DRAW CAR$πLINE (A - 2, 197)-(A + 17, 160), 0, BFπRETURNππRIGHT:πIF A = 200 THEN RETURNπLINE (A - 2, 197)-(A + 17, 160), 0, BFπA = A + 10πPSET (A, 195): DRAW CAR$πLINE (A - 2, 197)-(A + 17, 160), 0, BFπRETURNππSPEEDUP:πIF SPEED >= 15 THEN RETURNπSPEED = SPEED + .1πSOUNDLEVEL = SOUNDLEVEL + 10πRETURNπ πSPEEDDOWN:πIF SPEED <= 0 THEN RETURNπSPEED = SPEED - .1πSOUNDLEVEL = SOUNDLEVEL - 10πRETURNππ'Now THIS is the STUPID subroutine .π'I didn't want to complicate the program (for myself).π'So I copied the main subroutine once again and made the crash subroutine .π'NOW don't blame me ! I was new then remember ! I'm too lazy to change it now.ππCARCRASH:ππKEY(1) STOP: KEY(2) STOPππDOππLINE (100, 0)-(100, 200), 1: LINE (220, 0)-(220, 200), 1ππLINE (A - 30, B + 25)-(A + 30, B - 25), 0, BFππLINE (240, 10)-(260, 190), 1, BπLINE (240, 190 - TIMETAKEN * 9 / 10)-(260, 190), 2, BFππLINE (280, 10)-(300, 190), 2, BπLINE (280, 190 - (DISTANCE / 1000) * 5 * 9 / 10)-(300, 190), 1, BFππLINE (50, 50)-(75, 200), 1, BFπLINE (50, 200 - SPEED * 10)-(75, 200 - SPEED * 10), 2ππLINE (95, X)-(100, X - 95), 0, BFπLINE (95, Y)-(100, Y - 5), 0, BFπLINE (95, Z)-(100, Z - 95), 0, BFππLINE (220, X)-(225, X - 95), 0, BFπLINE (220, Y)-(225, Y - 10), 0, BFπLINE (220, Z)-(225, Z - 95), 0, BFππIF FINISH$ = "WIN" THEN LINE (100, FINISHLINE)-(220, FINISHLINE + 10), 0, BFππIF Z > 240 THEN Z = 0πIF Y > 240 THEN Y = 0πIF X > 240 THEN X = 0ππIF SPEED >= 0 THEN X = X + SPEED: Y = Y + SPEED: Z = Z + SPEED: SPEED = SPEED - .1πLINE (A + 5, 175)-(A + 15, 195), 0, BFππLINE (CARX, CARY)-(CARX + 20, CARY + 35), 0, BF: LINE (CARX + 5, CARY + 10)-(CARX + 15, CARY + 30), 0, BFπLINE (CARX + 5, CARY + 7)-(CARX + 15, CARY + 10), 0, BFππIF 50 - INT(DISTANCE / 1000) <= 0 THEN FINISH$ = "WIN"πIF 200 - TIMETAKEN = 0 THEN LOCATE 11, 16: PRINT "TIME UP": BEEP: SLEEP (2): STATUS$ = "LOSE": GOSUB PLAYAGAINπCARY = CARY - 3πDISTANCE = DISTANCE + SPEEDπSYSTEMTIME = INT(TIMER)πTIMETAKEN = SYSTEMTIME - STARTTIMEππLINE (95, X)-(100, X - 95), 1, BFπLINE (95, Y)-(100, Y - 5), 1, BFπLINE (95, Z)-(100, Z - 95), 1, BFππLINE (220, X)-(225, X - 95), 1, BFπLINE (220, Y)-(225, Y - 10), 1, BFπLINE (220, Z)-(225, Z - 95), 1, BFππIF FINISH$ = "WIN" THEN LINE (100, FINISHLINE)-(220, FINISHLINE + 10), 2, BFππ'Rotate carπDRAW "TA=" + VARPTR$(ANGLE)πPSET (A, B)πDRAW CAR$ππLINE (CARX, CARY)-(CARX + 20, CARY + 35), 1, BF: LINE (CARX + 5, CARY + 10)-(CARX + 15, CARY + 30), 2, BFπLINE (CARX + 5, CARY + 7)-(CARX + 15, CARY + 10), 0, BFππSTARTIME = TIMERπDOπtime = TIMERπLOOP UNTIL time - STARTIME > .01ππLOCATE 1, 1: PRINT "Speed :"; INT(SPEED * 10)πLOCATE 2, 1: PRINT "Crashes :"; CRASHπLOCATE 3, 1: PRINT "Kms :"; 40 - INT(DISTANCE / 1000)πLOCATE 4, 1: PRINT "Time :"; 200 - TIMETAKENπSOUND (SOUNDLEVEL), .03ππIF A > 190 THEN A = 190πIF A < 130 THEN A = 130ππ'Determine direction of spin and centre car if it spins out of roadπIF CARX <= A - 15 THEN ANGLE = ANGLE - SPEED ELSE ANGLE = ANGLE + SPEEDπB = B - SPEED * .05: IF ANGLE <= -360 OR ANGLE >= 355 THEN ANGLE = 0ππIF FINISHLINE >= 200 THEN GOSUB VICTORYπIF SPEED < 0 THEN SOUNDLEVEL = 440πSOUNDLEVEL = SOUNDLEVEL - 10ππLOOP UNTIL SPEED <= 0 AND CARY < -50πLOCATE 1, 1: PRINT "Speed : 0"πSLEEP (2)πSOUNDLEVEL = 1000πSPEED = 0: ANGLE = 0: B = 195: CLSπRETURNππVICTORY:πKEY(12) STOP: KEY(13) STOP: KEY(1) STOP: KEY(2) STOPππSPEED = 0πFOR I = 200 TO 0 STEP -1πLINE (A - 2, I)-(A + 17, I + 30), 0, BFπPSET (A, I): DRAW CAR$πSTARTIME = TIMERπDOπtime = TIMERπLOOP UNTIL time - STARTIME > .005ππNEXT IπCLSπCIRCLE (165, 85), 50, 1: PAINT (165, 85), 1πCIRCLE (160, 80), 50, 2: PAINT (160, 80), 2πLOCATE 10, 16: PRINT " YOU WIN !!":πPLAY "MFo3L8ED+ED+Eo2Bo3DCL2o2A": SLEEP (1)ππSYSTEMππPLAYAGAIN:π50 CLS : LOCATE 11, 13: INPUT "QUIT ?(Y/N)"; ANS$: ANS$ = UCASE$(ANS$)πIF ANS$ = "N" THENπCLSπIF STATUS$ = "LOSE" THEN GOTO 1 ELSE RETURNπEND IFπIF ANS$ = "Y" THENπSCREEN 2: SCREEN 0: CLSπLOCATE 10, 25: PRINT "This game was written in QuickBasic"πLOCATE 11, 22: PRINT "You are free to distribute it as you like."πLOCATE 12, 28: PRINT "Do send in comments at:"πLOCATE 13, 27: PRINT "[e-mail]"ππLOCATE 15, 30: PRINT "Thanks for playing..."πDO: LOOP UNTIL INKEY$ <> ""πCLS : SYSTEMππELSE GOTO 50πEND IFπDavid Zohorb                   SOLO DOGFIGHTING               www.wp.com/80948/qb/           07-06-96 (00:00)       QB, QBasic, PDS        115 7555     SOLO.BAS    DEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"SOLO.ZIP",4^6:Z&=5396:?STRING$(50,177);πU"%up()%9%%%R-%+PTfCuk*6fL(.%%^c%%%-%%%%xt%qtSgUx%fj<D=Lq19OjM^wIπU"Gnt3HCe&$J;QfQE#Rc)9QY,.9+ZGt-vp^j8/cS]lkTl>8:N_UVm#=Y(I<4e[k>]πU"#>$7kT/W>WJvSB6jjKcjX\GLq.:x(i&LJ]cm(.=Up+tmI;Vyca=DRqfhBg,#:2XπU"g3XV#YpXE]KIa;a'N)2j0u5e4$4m#Wf?j1O=/B$MkL,rmbsc\EGS1fe2*3M,\0jπU"8=xobPgKVHsD>TiJwf-BL12;;)q1KSXU_9?-FMRn0R<%]#9jW#ZW^0Wn>vLtBg\πU"gr)EA84q$VOCI#oZF?Sa<t]i]ZFHEirX(buJ-g_[=69HIR,o$R/A,HM;VotpV2VπU"1>7>2iH$^A0pGw5ptujkuNB&'bUbr#U\*k[^5b$VjdK%:tkK.s)YBSBXrGT*snNπU"FUGwLBVIe3hegYoTDCCg&J,cjaJi<C0kIk)tt8Y;MYl*c2QkrHAg4b:j:vf)mAdπU"Dm(1nL+js=w*V6dQZjLUV,V=(OO2Yg]$H/87995Wx]rRA9:S[a]uYa5X2aj(pLjπU"M#Tq.+bp\PkDJfr*lpn04/.B^8]QXh+UvKsF#^WSAtr?A'E47zLkoTuaNpV)xX6πU"cCP-?#y_E&:,m;PPG&LmbbV;1k_GsR4J>-zNlZ0vrS^s**E>^(Ydd(?oFzr*,,6πU"D#NWg.tD0E1TLfvh.;o6r+Nu%h.r+:g#eUZM.$hf*^eMcgXV720YdD#iQO'8U>6πU":EfoY]%PkR_d#*]q*^Hp:;)c<prAP<dFgr=/B_TV^):Ao*dkXgT45/tnXoT.f$;πU"Pr[yD#Y_cU)o^\0utB8k5ORu1^q?2Pq+jgz\_A\D0VA>.nNB2l.Hjpzle,eECHlπU"tc,j>4(8oQz'gsF<344YD0vq%:he:*,/--3-LWqM%H8Z^PxJkMl>wb5i\XYF5cnπU"ldK9*3n>gKr7$ntm6&P2NnCLa(U,dJ9,NSR^K=^o.[]TnoC9+n=OkPs,>Bt5%)fπU"5)%f5)f%5)f5%)f5)%f5)f%5)f5%)f5)%f5)fg5=f]uXIhu%+up(%)9%%[%-%qGπU"b_EB<X<CD[6%%d&2%%-%%%%x%tqtS[gfxfe+p>\<AEW#*iN]HI1UA*_EbjK2edmπU"kQU/K*DW<>aO?G+3Lh*;Z8<nMJsNTCXL?3j;PQe5f^zMrcQ:#x1)$Ir$]7f0NNgπU"IKDUCDcDn'jwksdx2rKhdEFbMrBscVDSIlXZvLmcyvsf:]OllYZzxpUYvba(usdπU"HxPDjlxw\l:D[u-;50i5f38oJf4*+2-\*#3#4&SQg5QG]ATNGQ?*xafoEOvG]d,πU"x(R&9odEwj)p4,wck:L=e,oL+E?Jm#H?dDq2p1cUXlqXEYW/lwTi'v$4gHH6DHLπU"h?2wRr)hN,K14KSbhsv7+t70Vl8eT[xT+hY/[s29?U^DtA9ff#RAe<s9#,OutpHπU"H<HV\E;GkH=PXpr/?[FU,:TIXYsse_tu8V6HZqtLpEpA]Y=L\SFfU-#$<,#YweHπU"GgE'hl5*6limNjVm'W1GgB2+iv]56&:G%,2k8JPLZH20q?IC7PCsvjAsFlU]80sπU"dN#hu<lWN1e2;vcahi:ung/?S\eJM<:5Q$NA2c3u=4exsFO8$PX,xBj<;La2HvqπU"5/LUAv^fJtAh]rHVcCDH;zlxX*mqnNXV/p9G,<_lp%gs0gp?Hpgbod(iY.saG30πU"v]ug6_6z&M6/mkg]V[?rF4t-<XUlSD+F,?TNbh+fu+RHelctwVtFOU6,gH#e=$RπU"H]VT(1EfD+RooZU-MJ&lMZ8L6UVZ-pYI6?K=-<b</TdV3+'5E1<cYW*l4=[$,Y2πU"pw$RZOd.KWY]'O$,K0o]+UFf\+[5I*zV*VZjoh4vc?R^agQ+fJEgergk0HIStJ<πU"raNr='%Z3GO4cJTWu6CZt4hgmss(H4q&l8/Y0I293pEFk+Xq:QBK'TX6JClPnWkπU"w%;M;eZMG[WwBpW#ZSg#>m8WruM(oPfw6^WljA5Cr9*#pTG)Fm$6E*(Q?5Q$&duπU"mE3LI%gZ')QWiG4veUTMDZBqBJjC\J(yOQE4ws7(JZ;2u6aw$?3<N;M#B^9/'$BπU"Djb1D#G^.Yn-iux=$t#aoQYG^0OAEV-=-LY^Ch(ADICqNXpFIoU+=u]PW-HZDR%πU"XPnC[7bGqo$%QlZ>RUu'ie:[U59G=St4$SnS4vK$uZQ2#?G<sbJeljSUMgP+/pBπU"ovtfXDM5)9XR1eEh>EFsk66EtC?]#/OY9sN)H6]B2kQ0Y<k?Ehbm,6_#=*RU*_*πU"MADf1qbSTOE#SY^W]Fs.a'7Hn49.x+/&D0;Ci(MWA*ZL=Fj];Wq,j%A/F<UyNM&πU"]VRBL\b4ihe[p:4f:%Vf^F>>1W[12(8jG&0aVhzKDU5YjV0r,[yCj4,YJH(t%?aπU"?ep-E^\'Zwdd:V(7q,Q*lUGb)O'i7Bvb9SN?XS:Q8$Axn5dY=lE+>(9uBIb8XXyπU"c'S:/[Mo:m5N).__tfS:zL02pqN-[e;Yvjz]Z2^VVzF25z/Yl,R*9pYfBU5cn9;πU"1ojT[0EK6.5o,9xU&7%YWs:N'.z,p3;2uZ,(kZ^n*<e=hI&m%,h0,4.apOz\=i?πU"QmmXXF:PgKOsFS<MiYlA4k:8loL3k=x12Ba1s</r,yRCj495Z&1z%*xe649-cmTπU"<Yk/+9PM>2O/7LsIHZS>(3)557](B4xFz=s[<%=V:To(_xlPemzeZ6PzOy]$5NPπU"'\zW%:Yy%*Ysz0:%<TR7DV5do(_xlPeZ.G3YE4T?AFq*Hu$6<BE;YLst-eppV'/πU")p%>Gh3;$?_,QU+gKoip;egDS-BRD+\7n^rAl/0<Qbl/GmN'*?(2x<b^aV>zR7UπU"H<%WjV0%(Oq(LF%M'Jdu#WB.bTujW'::l\Oa_r(&Dk2:ugmvI%h-CJYl<(/;no0πU"eZOssWm::KD/b[5EvlnSv$ui(>u2jMJ%$n>2iop?1uZ3vHRTVBjF,F$T1n3Y9QLπU"$wjs(f(L45iXsu;Sd7Vl2Qrq%\L9$1:GBg0*(Y\lQ&Q0uPPr*NFjcYf5^x[3INBπU"W<*B.\[L9$[.P-4FlW[+HJ6,3lTdf6FnL3h9aG?Ce8RN<;jOE;cM/#P)L'1QQUTπU"5lxTpaom$5#0q<j*$'7kXq%$]gB^&-(d1qtNo:?RVZeSi;xB=w[-yP35Rr3Vl79πU"f=YV)kTnTbAHiHZaYkg+IQCr$On9]PK$8isMx$kKa?sF<'J'NkFimNX#7O-*npiπU"'M3=x7sTW[e?NM>OxM:k%)^ocw<b$DR2cuAuSSe#9nJG9dksUlo^<[gu5llOLkGπU"9-wNuIt2GQlpEFOS46vSR[)=#h1]Ors4t3SmySRkNZv97\bC<5aESI80I>>8zoCπU"O&_G_w;Sa3^ZdWue2kr%B?4G_V,:g;z0,*$M7hZ+AmC6nl6_h+e,5]4D-:YBR=TπU"g0T*T6(]G2p6gMLZr_U<p7mEw'T2]P+wc#JZn($FLrF6onHGq$kP2\_9?&byJmOπU"&wq:[2A-we5rnD6.z4Cze&vUp:wsR'Fcw/59L6L&FDArvX*b9;JPa/t8iDQ-dl:πU"\%gCxwp>Qd6I'nk>d24U_O%wvR(iNsX%RON&I$l4%n\f+Q+ZF0Su_tb[[2]5+xCπU"m?trNF4'aM2^f0K&A:qKrq-lNKDs$dR:;lIuirT:IZgh3VQF>HD6wPF]sHnE_TqπU"fJcZq76/+k:TOY5[-+2Xrq.E'TfRo9)M8[,D%f:z%_*KM[(iRUtdsMUka;J+QVtπU"oJ[^Rx>Idimx8rVh2&*>lBXe(\?cg%k%;FFD[bAZb.UBkQP1*NhkRT?5$NKqZh6πU"8S=kmK1Hy3gia[a.JHgb&$IP;A8IHyD3sMh/to5nha(IBXQEWa#IP;8aI,yBi%qπU"3/(OhRnb5dJ,LVJ*aN%'s$$E%J,DZa^yD3]IhqrfE:]eBn+)1$kWUldE$(IbiqqπU"F.cKhVFRSFfD,s%vWA>H9Dkr_p[j5$eazOP,F1(Z3w+m4pxo:Z1%/=I.s9rIj=pπU"%]Uwa&Z%TLIl3jlpnQnp-hP=8f;L<f:2CbcAaS+s<barGZ]):'&_^;ZZP/,T*=kπU"W9<^nj?Kqu$K/,AS7rJrj:*3;h_M,qBpGdnWa_LVef7M7ox()1Y7,pzdQG,Y9,UπU"nlObLixb[8JC,,WaCv>kAQzgX:lu-Tdom:/(O%f1)(nO6#cg8Z690fzqcY?>S2jπU"XnMArr5[p9ee.U\0+^S#peLTH:tlTDs.']BMxOKXPaJ30y1ac9p[),2ZveQ$iL#πU"E?*Kfsq2tPXoHXhl7b$k3?5bnW/W7ue0l?pTYDU/[yxW/H3-lFC=Vl*jyiOe,/eπU"N'^B^:kWODF\K;7pu&F]jC%.'kV%mDfKV*8X4_1*pHK1it+m-9.&umON&)Ojp=pπU"J;9f&oY/=oJOw]-Vj42aqrw,C-9BOqJxq&g1Mlm?uAn.N>dp;6g[Q27oAhj1t%[πU"^>a+F-GHeeQw*V7B129v&Omsf5iSf\n:)hubX]9aVYaFiXn+V)2)O,WH0a</NZ-πU"5PUd\*+mKHu;e8KT5n0t(HuLm#EE5Zg<jSOQP8-M.<Y9fmxLGn&S>k5[MBXho-RπU"^$^8>?x/*]rXOO,8I0D=R/LM8]gB;'Q2oxC**E.JVm=_0'm60aw-jJ=8;;Nf/E*πU"R2Q;20QkV;pC]MiAcuKy:=;A4H5a\vP?KR;OrSqatG0Z9*q'*R;cS?;OkF,T[ocπU"7BN#rx**1ENem?'''mS6047VZq0ZJTx;0D>40Jp#*QXKF;YB7tI$cIr:;P(aGG^πU"Hp3Gl1RkqR53x-:js*T,JdRk<5;ZKTG*Y,Ika357^aa2m<Fn^R$A9/X1J:q]b-lπU"wNNRbeq?Gbw)k:&&tWRn/o;wERob3_PJM59bDTNK(xPERs>W_bw5V9*dyk<6uSPπU"4lzhQH(jxk<(z/Nvi9f1r45chd<u/u,'SGM:x\mr:,oTeiL?Eer.uku-8em+A.NπU"c.m\b,8D>BIE+n^F+xhJk/V$)_=D9GDlHYboja7^YHh9sn%Myz]K;c)$l(.VHO]πU"rdW-Yg#J-%u50Q^gO8(Kf(5Gsm'P:Ox_]j6B'$90,Y%'K0*y-QEQ;L_Lb\1vsxcπU",1G+faSh&5cA'Zc$37I]Z#,ahLbd/pXu-qwM_,<TN[qkqBKTscK[g.e*ES[1d?iπU"ABMtG+$Nvs\QDu+?5JoB4gs=hv%+xbnn_ExI/eK=q#]*6rP(RM1V$T:nfT+4nW/πU".&8z^pvw#Yv6[7>Vx04k]Q_j6M#Ktqhnx%c#aI$*<J-x:JXeprHFMO)*eSx+13bπU"NK<kb?#[e?HKHs=H/YNHNMHqaFheb6pCZ&I>Px]^e)b6\Te&IN58k?8+E1SqBI^πU">#B>>.7vdjl+/G**X&R6o'QT']aesvKEC)zHB>QF&k^UqknKF5F%+gcg&iFN/xYπU"_;w9R:kx^CE<Eo(I#O4<PrMANe/$tep2d+0Uv9r=JN$tkL2dA%1zY<h;.18zT5:πU">fNR3b,gtFQoMm/_,E=7fI-P/*0BnyI,+:JB]bClxUujUV:AF1GChPb6Mki.1DsπU"T842$eAgoRhL+(LyJ8;3RTToVYx$T]C7p^1\^D#O[n]RS77k,_j3HrIP?3(PR&;πU"PBk+^)TKEC<'QZ#)b.$Av(^litLW<4+eichUqojQxX,&++eTRICC?UM>R:e&aWgπU"YI(i+hnBo$lBr,\DjP9Rl.IT#i7H\Qym0#M7,q'\e5,]+K,^uEWEH'eV,0t#)O]πU"VokZj]r>c_\/H3o/iAcX\LXdL]#AA=N:(RRH)v$3Tt7PjYJU5AapcikmWJH)BcuπU"NNmfefZ'><'UZHk:ytA%1#u(+MUHT#aHT\Jh,=U&rblvVlmIQHLF5RVasH\%$B^πU")NB\3w3=#V21EX#VIk7Q,A,7F?<Hm7]W?[/Zm(QXvTV0[A)2LU94%/EG2h+Y$N+πU"'tiwF,27I7n;$)sKMcj,y.dWod>7XY0cl[c40<S1#X+3UFTW$6TG)eC3t>H1e'JπU"?xy<8p:L,)eWJ&2KA[oMs[fQ&+%+gv'bXOT0%_ke08.o1jbm5>^s$Q/]2WUL(E7πU"esFLLbvo#t2c8CDDS-093x_;dbbK1=H8H]AsH1l5.NzJ;s+<2q;g7i:W'Qbr$0OπU"tl3AnIvqC'Dc5Dqvw3:jM0F;WuKN7bLLT-&gC7-Sx[P<eT-a9LwoSHzo4Y*w>*BπU"o&uFgC^Q)_$bp7\,Pcs)(n+Up1uu,K/5IN5jtp\EUR]7oNyjHisRkAcvt%G0VLNπU"-AN2k0M?ff'9#l#l6iB,aa,:UHW7?<X1dLWNYjHwGRAZYyTL%48P(GPD\3A:Qr*πU">mkatF367n5*;U7.e4>iLSh]XBDEq6?f2sFUs\UFKo+6o6'\;UILYuoe\\F(#^9πU"[C;MXDS-9Pp0^W[5?BVUYJf:f*WDWH$)r%w:Oni3gcKSmoJ[d?cL-#T^+JQ#$VZπU"Nc?r_gs0Jbx$j+5RmKNWX[hrHOv?pj;q7UC7Iu(8)04y-O*/Idu-cq^ZWo26$wFπU"qQ+f,7hEnmyXd5$_z_3/HQhvpj.gdK$Axb3P%L(OVpdH&^9PJ2B7fSYQ]H'C)H>πU"0eZA*G%m//^,8/E70-kMbh1NN%VGj&G=dO4DWd,nI^LH0xmt[:a:Rv0ddJ9SvigπU"j/gU<LrSu%xe\sBEXJu]x<K_dek/*w.up%&'9%%9%%%R-%+PTfCuk*6fL(.%%^cπU"%%%-%%%%%%%%%%%%E%%%%%%%%%xtqt#Sgx%%up&'%9%9%%%%-%<qb_EkBX<C%D6πU"%%*d2%%%-%%%%%%%%%&%E%%%%r(%%%xt%qtSg%fxup%*+%%%%%'%.'%;%.%%a9%πU"%%%%πEND SUBπCLOSE:IF S=135AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπSteven Hanov                   LEAPGUY                        [e-mail]              06-12-96 (00:00)       QB, QBasic, PDS        809  31246    LEAPGUY.BAS '****************************************************************************π'*                          IDENTIFICATION                                  *π'*                                                                          *π'*                NAME:       Steven Hanov ([e-mail])             *π'*                PROGRAM:    a:\class.bas                                  *            *π'*                SCHOOL:     Cardinal Newman C. S. S.                      *π'*                TEACHER:    The teacher formerly known as Mrs. Gotovac.   *π'*                COMPUTER:   IBM/MS-DOS                                    *π'*                LANGUAGE:   QBASIC                                        *π'*                PLANET:     Earth (Sol-III)                               *π'*                PERIOD:     LATE 20th CENTURY (Gregorian Calender)        *π'*                CLASS:      DPT 3A1 Period 2                              *π'*                DATE:       96/06/12                                      *π'*                                                                          *π'****************************************************************************ππ'****************************************************************************π'*                       PROGRAM ANALYSIS                                   *π'*                                                                          *π'* In the 1980s, when the dinosaurs ruled the earth, we all used computers  *π'* like the Commodore 64. It was great for games, and one game I liked was  *π'* JUMPMAN (By EPYX MegaGames). This program is a re-creation of what I     *π'* remember of the game. It has four levels, and is not entirely accurate.  *π'* However, it presented a unique programming challenge that I was not      *π'* entirely confident that I could meet. But after many hours of work, both *π'* in and out of class, the project is finally completed.                   *π'*                                                                          *π'* The object of the game is to pick up all of the brown "bombs".           *π'* Occasionally, white SmartDarts will fire at you from the sides of the    *π'* screen. To move, make sure the numeric keypad is ON. The controls are    *π'* on the keypad, and should be obvious. 8, 6, 2, and 4 move up, right,     *π'* down, and left, respectively. 7 and 8, and 9 are also used to jump.      *π'*                                                                          *π'* One problem I had was speed; on a slow computer the character moves      *π'* fine, but on a fast computer the gameplay is impossible. I surmounted    *π'* this difficulty with the speed option in the introductory screen.        *π'* On the school's computers, a value of one to three should be used. This  *π'* value is used to control the speed of both the character and the         *π'* SmartDart.                                                               *π'*                                                                          *π'* Enjoy!                                                                   *π'*                                                                          *π'****************************************************************************πDECLARE SUB HighScores ()πDECLARE SUB paldef (c!, r!, g!, B!)πDECLARE SUB ClearKeyBuffer (n!)πDECLARE SUB centre (y!, t$)πDECLARE SUB UpdateScore ()πDECLARE SUB Die ()πDECLARE SUB Bullet ()πDECLARE SUB pandisplay (xp!, yp!)πDECLARE SUB DrawGuy (x!, y!)π'****************************************************************************π'*                       VARIABLE DICTIONARY                                *π'****************************************************************************πDIM SHARED graph(1000), pf(40, 25) AS STRING, sndπDIM SHARED bgraph(100), x, y, xx, xy, DontDraw, lives, dead, bombs, PointsπDIM SHARED DartSpeed, GuySpeed, Delay, ResetFlag, BonusπDIM SHARED Score(15), Name$(15), TotalScore, FileName$ππ'NAME ***** DESCRIPTION ************************************************π'graph()    The image of the background behind the character is storedπ'           in here, using the GET and PUT graphics commands.π'bgraph()   Likewise, but with the bullet.π'pf(x,y)    The current level is stored in here using the symbols explainedπ'           in the data statements.π'x,y        The current co-ordinate on the screen, in 8x8 units. The screenπ'           is 40 units horizontally and 25 vertically.π'xx, xy     The true, pixel co-ordinate on the screen. Range: 320,200π'DontDraw   A flag for the DrawGuy sub telling it not to call the Bullet subπ'lives      Self explanatoryπ'dead       A flag that lets the main program know if the bullet hasπ'           contacted the player.π'bombs      The number of bombs remaining on the playing field.π'points     The number of bombs the player has picked up. Whenever it'sπ'           displayed, its multiplied by 100. The points are reset wheneverπ'           the player dies to make it more challenging.π'GuySpeed   Used in the DrawGuy sub in a delay loop to slow it down.π'DartSpeed  Derived from DrawGuy. Controls dart speed.π'Delay      This flag tells the bullet sub not to delay because it isπ'           being called by the DrawGuy sub, which has already delayed.π'           This makes the two objects move at the same time more smoothly.π'ResetFlag  Tells the DrawGuy and Bullet subs to re-GET the backgroundπ'           that they're on (into the GRAPH and BGRAPH) on a level changeπ'           or else they'd draw a chunk of the old level on the new one.π'Bonus      Contains the time bonus remaining for the level.π'TotalScore Contains the total score in the game divided by 100.π'Score()π'Name$()    Used to read and sort the high scores from diskπ'FileName$  The name and location of the score file.ππ'****************************************************************************π'*                              MAIN                                        *π'****************************************************************************πRANDOMIZE TIMERπKEY 15, CHR$(0) + CHR$(1) 'Defines Key# 15 = Escπ'ON KEY(15) GOSUB Ending    'ANYTIME user hits escape, gosub Ending.πON TIMER(10) GOSUB DecrementBonus   'Sets up the timer - Every ten seconds,π                                    'you loose 100 time bonus.πTIMER OFF                           'But not right now.πKEY(15) ONπlives = 6πsnd = 1       'Clicking sound on movement ONπrt$ = "6"     'Define RIGHT keyπlt$ = "4"            'LEFT keyπUP$ = "8"            'UP keyπdn$ = "2"            'DOWN keyπDelay = 1            'Delay on call bullet sub.πFileName$ = "SCORES.DAT"πSCREEN 13πππy = 0: x = 0πFOR s = 1 TO 25π   READ l$π   x = 0π   FOR d = 1 TO 40π      a$ = MID$(l$, d, 1)π      IF a$ = "W" THEN             'Displays in the introductory screenπ         c = 15                    'graphic, which is stored in DATA.π      ELSEIF a$ = "R" THEN         'It looks just like the old C=64 game!π         c = 4π      ELSEIF a$ = "M" THENπ         c = 5                     'R=RED square, M=magenta, C=cyan,π      ELSEIF a$ = "C" THEN         'Y=yellow, G=Green,B=Blueπ         c = 3π      ELSEIF a$ = "Y" THENπ         c = 14π      ELSEIF a$ = "G" THENπ         c = 2π      ELSEIF a$ = "B" THENπ         c = 1π      ELSEπ         c = 0π      END IFπ      LINE (x, y)-(x + 7, y + 7), c, BFπ      x = x + 8π   NEXTπ   y = y + 8πNEXTπππWHILE INKEY$ = "": WEND   'Wait for keypressπCALL HighScores           'Display HighScoresπPLAY "mbt128 O3 C16 O1 c16"πCLSπCOLOR 3πcentre 2, "LeapGuy"πcentre 4, "By Steven Hanov"πLOCATE 6: PRINTπCOLOR 5πPRINT " Movement:"πCOLOR 14πPRINT " 7   8   9     Make sure your numlock"πPRINT "               key is ON.  Use 7, 8, "πPRINT " 4       6     and 9 to jump left, up,"πPRINT "               or right."πPRINT "     2    "πLOCATE 19: COLOR 2πPRINT "Choose a speed for LeapGuy,"πPRINT "from 0 (fast) to 15 (slow):";πINPUT "", GuySpeedπ'IF GuySpeed = 0 THEN GuySpeed = 8πGuySpeed = GuySpeed * 100πDartSpeed = GuySpeed \ 25πIF DartSpeed = 0 THEN DartSpeed = 10ππNextLevel:πFOR y = 1 TO 25                   'Reads in the next level from DATAπ   READ l$                        'and stores in pf(x,y)π   IF l$ = "STOP" THEN GOTO YouWon  'UNLESS there are no more levels.π   FOR x = 1 TO 40π      pf(x, y) = MID$(l$, x, 1)π   NEXTπNEXTπREAD OriginalX, OriginalY       'Starting position for JumpGuyπClearKeyBuffer 15           'A sub that stops a really annoying problem.πBonus = 1000ππReDraw:πIF lives = 0 THEN          'IF the user has no life,π   TIMER OFF                          'Don't decrement the bonus anymore...π   PLAY "T128 MB O1 L4 c2 e2 g2 >c1"π   seconds = TIMERπ   WHILE TIMER - seconds < 4          'Flash screen red and white forπ      pandisplay 1, 0                 'four seconds.π      paldef 2, 63, 63, 63π      FOR d = 1 TO 100: NEXTπ      pandisplay 0, 0                  'AND a cool earthquake effectπ      paldef 2, 32, 0, 0             'with an OUT call I got from the 'Netπ      FOR d = 1 TO 100: NEXTπ   WENDπ   paldef 2, 0, 32, 0             'Turn colour 2 from red to back to greenπ   PLAY "MBO3 C8 <G8 >C8 <G8 A#8 F8 A#8 F8"π   PLAY "G#8 D#8 G#8 MN G8 G#16 G"π   CALL HighScoresπ   ENDπEND IFπx = 0: y = 0       'BUT if the user has a life, they can play...πbombs = 0πdead = 0πDelay = 1πCLSπFOR s = 1 TO 25                'Redraws the level stored in pf(x,y)π   FOR d = 1 TO LEN(l$)π      a$ = pf(d, s)      'YES, it is declared as a string...π      IF a$ = "=" THEN                'The girder/π         LINE (x, y)-(x + 8, y), 2π         LINE (x, y + 4)-(x + 8, y + 4), 2π         LINE (x + 2, y)-(x + 2, y + 4), 2π         LINE (x + 6, y)-(x + 6, y + 4), 2π      ELSEIF a$ = "#" THEN                   'The ladder.π         LINE (x - 4, y)-(x - 3, y + 8), 1, BFπ         LINE (x - 4, y + 4)-(x + 12, y + 5), 1, BFπ         LINE (x + 12, y)-(x + 11, y + 8), 1, BFπ      ELSEIF a$ = "+" THEN                     'The ropeπ         LINE (x + 2, y)-(x + 3, y + 1), 2, BFπ         LINE (x + 4, y + 2)-(x + 5, y + 3), 2, BFπ         LINE (x + 2, y + 4)-(x + 3, y + 5), 2, BFπ         LINE (x + 4, y + 6)-(x + 5, y + 7), 2, BFπ      ELSEIF a$ = "o" THEN                      'The bombπ         CIRCLE (x + 4, y + 4), 2, 6π         bombs = bombs + 1π      END IFπ      x = x + 8π   NEXTπ   x = 0π   y = y + 8πNEXTπLINE (0, 290)-(320, 290), 5        'A line that won't show up I know not whyπππReStart:πPoints = 0πx = OriginalXπy = OriginalYπxx = x * 8πxy = y * 8πFOR s = 440 TO 600 STEP 10π   SOUND s, 1πNEXTπResetFlag = 1πCALL DrawGuy(xx, xy)               'Displays guy for first timeπResetFlag = 0πTIMER ON                       'Turn on decrement time bonus eventπCALL UpdateScoreππDOπ   a$ = ""π   snd = 1                     'Click sound on (movement)π   IF jump = 0 THEN            'If not in the middle of a jump,π      ClearKeyBuffer 5         'Clear keyboard buffer,π      DOπ         a$ = INKEY$           'Get the keypress,π         CALL Bullet           'Move the bullet,π         IF dead = 1 THEN GOTO ReDraw   'If the bullet killed you.π      LOOP UNTIL a$ = rt$ OR a$ = lt$ OR a$ = UP$ OR a$ = dn$ OR a$ = "4" OR a$ = "6" OR a$ = "7" OR a$ = "9" OR a$ = "N" OR a$ = CHR$(27)π   END IFπ   IF jump = 2 THEN jump = 0    'Just finished a whole jump.π   IF a$ = rt$ AND x < 39 THEN   'Move right, don't go off edge.π      FOR s = 1 TO 8π         xx = xx + 1π         CALL DrawGuy(xx, xy)π      NEXTπ      x = x + 1π   ELSEIF a$ = lt$ AND x > 2 THEN  'Move left, don't go off edgeπ      FOR s = 1 TO 8π         xx = xx - 1π         CALL DrawGuy(xx, xy)π      NEXTπ      x = x - 1π   ELSEIF a$ = UP$ AND pf(x, y) = "#" THEN 'The user is on a ladder, soπ      FOR s = 1 TO 8                       'move UP, (NOt JUMP) when theyπ         xy = xy - 1                       'press 8.π         CALL DrawGuy(xx, xy)π      NEXTπ      y = y - 1π   ELSEIF a$ = dn$ AND pf(x, y + 1) = "#" THEN 'Go down a ladder.π      FOR s = 1 TO 8π         xy = xy + 1π         CALL DrawGuy(xx, xy)π      NEXTπ      y = y + 1π   END IFπ   IF pf(x, y) = "#" THEN jump = 0      'If they jumped onto a ladder,π   IF pf(x, y) = "=" THEN               'Stop the jump.π      FOR s = 1 TO 8π         xy = xy - 1                    'If they're right OVER a girder,π         CALL DrawGuy(xx, xy)           'Climb on top of it.π      NEXTπ      y = y - 1π      jump = 0                          'And stop jump that your in middle ofπ   ELSEIF pf(x, y + 1) = " " AND jump = 0 AND pf(x, y) <> "#" THENπ      fell = 0                        'If you're standing on air,π      FOR d = 1 TO 2π         IF pf(x, y + 1) <> " " THEN EXIT FORπ         snd = 0π         FOR s = 1 TO 8                     'Fall up to two units.π            xy = xy + 1π            CALL DrawGuy(xx, xy)π         NEXTπ         snd = 1π         y = y + 1π         fell = fell + 1π      NEXTπ      IF pf(x, y + 1) = " " AND fell = 2 THENπ         CALL Die                       'If you fell two units, and youπ         GOTO ReDraw                    'STILL haven't landed, you're out ofπ      END IF                            'luck.π   ELSEIF pf(x, y) = "+" OR pf(x, y - 1) = "+" THENπ      FOR s = 1 TO 8                   'If you're legs or torso is on aπ         xy = xy - 1                   'rope, climb it.π         CALL DrawGuy(xx, xy)π      NEXTπ      y = y - 1π      jump = 2π   ELSEIF pf(x, y) = "o" OR pf(x, y - 1) = "o" THEN 'On a bomb?π      PUT (xx - 8, xy - 16), graph, PSET            'Erase Jumpmanπ      IF pf(x, y) = "o" THENπ         pf(x, y) = " "                           'Get the bomb if under legsπ         LINE (xx - 8, xy - 8)-(xx, xy - 1), 0, BF 'Erase bombπ      ELSE                                        'OR ELSE:π         pf(x, y - 1) = " "                        'Get if under torsoπ         LINE (xx - 16, xy - 16)-(xx - 8, xy - 8), 0, BF  'erase itπ         'LINE (xx - 8, xy - 16)-(xx, xy - 1), 0, BFπ      END IFπ      PLAY "t128 mb o1 l32 c o4 ccc"               'Sound effectπ      LINE (xx - 8, xy - 16)-(xx, xy - 1), 0, BFπ      GET (xx - 8, xy - 16)-(xx + 7, xy - 1), graph  'Stores new image,π      CALL DrawGuy(xx, xy)                           'without the bombπ      Points = Points + 1                      'Draw guy on top, increaseπ      CALL UpdateScore                        'points, and display new pointsπ   END IFπ   IF jump = 1 THEN               'If the user's in apex of a jump,π      IF x < 38 AND x > 2 THEN    'And they're not in danger of passing edge,π         snd = 0                  'Turn movement click sound flag offπ         FOR s = 1 TO 8π            xy = xy + 2           'Jump back down to earthπ            xx = xx + xstepπ            CALL DrawGuy(xx, xy)π         NEXTπ         y = y + 2π         x = x + xstepπ         snd = 0π      END IFπ      jump = 2                   'Completed jump cycleπ   END IFπ   IF (a$ = UP$ OR a$ = "7" OR a$ = "9") AND pf(x, y) <> "#" THEN 'Jump.π      IF a$ = "9" AND x < 38 THEN       'Jump RIGHT.π         xstep = 2π      ELSEIF a$ = "7" AND x > 2 THEN    'Jump LEFTπ         xstep = -2π         max = 2π      ELSEπ         xstep = 0                    'Jump UP.π      END IFπ      PLAY "MBT128L32ML o3 CEG>C<GEC"π      snd = 0π      FOR s = 1 TO 4π         xy = xy - 2                 'Preform exactly 1/4 the jump.π         xx = xx + xstepπ         CALL DrawGuy(xx, xy)π      NEXTπ      y = y - 1π      FOR s = 1 TO 4                'The next quarterπ         xy = xy - 2π         xx = xx + xstepπ         CALL DrawGuy(xx, xy)π      NEXTπ      y = y - 1π      x = x + xstepπ      snd = 1π      jump = 1π   END IFπ   IF Points = bombs THEN EXIT DO      'You've won the level.π   IF a$ = "N" THEN EXIT DO          'THE SECRET ****CHEAT CODE******π   IF dead = 1 THEN GOTO ReDraw      'Restart the level.π   IF a$ = CHR$(27) THEN GOTO EndingπLOOPπPlayTunes:                             'At this point, you've passed level.πa = INT(RND * 3)πTotalScore = TotalScore + Points + BonusπPLAY "MF"πSELECT CASE aπ   CASE 0          'Picks one of these congratualatory themes.π      PLAY "O3T128MN L4C <G8 >C< G8 F8 G8 E16 F16 G16 A16 B16 >C16 D16 C1"π   CASE 1π      PLAY "O2 L4MN T200 C<G >C< G >C<G C G >L8 GF#G G# G G# A A# A A# B >C<G>C2"π   CASE 2π      PLAY "O2 L4MN MBT200MN C8 D# G8 >C< A#. G2 D#8 F D#8 F# A#2 F#8 F8 D#8 C8 <A#8 >C1"πEND SELECTπGOTO NextLevelππYouWon:     'The level re-drawer will send computer here if no more levels.πTIMER OFF   'Can you smell the meatballs in this plate of spaghetti? :-)πCLSπCOLOR 15πClearKeyBuffer 15πcentre 12, "*** YOU WON ***"πWHILE INKEY$ = "": WENDπCALL HighScoresπENDππ'****************************************************************************π'*                           SUBROUTINES                                    *π'****************************************************************************πDecrementBonus:πIF Bonus > 0 THEN           'This sub gets called every 10 seconds duringπ   Bonus = Bonus - 100      'game play (See help on "ON TIMER()" command)π   SOUND 440, 1π   CALL UpdateScore       'Decrements time bonusπEND IFπRETURNππEnding:πCLSπCOLOR 14πcentre 12, CHR$(2) + " Buh-Bye! " + CHR$(2)πENDπRETURNππCreateNewFile:πCLOSE 1                   'Gets called by Highscores if scorefile doesn'tπOPEN FileName$ FOR OUTPUT AS 1   'exist.πFOR s = 1 TO 15π   PRINT #1, "------------"      'This creates a new fileπ   PRINT #1, 0πNEXTπCLOSE 1πRESUME                        'And resumes where the "FILE NOT FOUND"π                              'error occured.ππ'This following is the intro-screen graphic.πDATA "   CCC   C CC CC CCCC    CC CC  CC  C  C"πDATA "   C C   C C C C C   C   C C C C  C CC C"πDATA "C  C C   C C   C CCCC    C   C CCCC C CC"πDATA " CC   CCC  C   C C       C   C C  C C  C"πDATA "                                        "πDATA "                        BBBBBBBBBBBB    "πDATA "            WWWW        BB        BB    "πDATA "          WWWW    WW    BB        BB    "πDATA "        RRRRRRRRRR      BB        BB    "πDATA "      RR  RRRR          BBBBBBBBBBBB    "πDATA "      WW  RRRR          BB        BB    "πDATA "          MMMM          BB        BB    "πDATA "        MMMMMMMMMM      BB        BB    "πDATA "      MM        MM      BBBBBBBBBBBB    "πDATA "    WW          WWWW    BB        BB    "πDATA "          YYYY          BB        BB    "πDATA "          YYYY          BB        BB    "πDATA "                        BBBBBBBBBBBB    "πDATA "                        BB        BB    "πDATA "    GGGGGGGGGGGGGGGGGGGGBBGGGGGGGGBB    "πDATA "    GG  GG  GG  GG  GG  BB  GG  GGBB    "πDATA "    GGGGGGGGGGGGGGGGGGGGBBBBBBBBBBBB    "πDATA "                                        "πDATA "                                        "πDATA "                                        "ππ'The following are the levels. After each is the staring x,y position.π' It is possible to add more before the "STOP". Each is 25 lines.πππ'     1234567890123456789012345678901234567890πDATA "                                        "πDATA "                                        "πDATA "                                        "πDATA " o           o           o            o "πDATA " ==#===   ====  o     o  ====   ====#== "πDATA "   #               #                #   "πDATA "   #           ====#====            #   "πDATA "   #        o      #      o         #   "πDATA "   #      ====     #    ====        #   "πDATA "   #         ======#=====           #   "πDATA " o #   o           #           o    # o "πDATA "   #               #                #   "πDATA "   #           #   #   #            #   "πDATA " ====  ===   ==#=======#==   ===   ==== "πDATA "        +      #       #      +         "πDATA "        +      #       #      +         "πDATA "               #       #                "πDATA "   #      ===================       #   "πDATA " ==#=======                 ========#== "πDATA "   #                                #   "πDATA "   #         o         o            #   "πDATA "   #                                #   "πDATA " o #           =======              # o "πDATA " ====================================== "πDATA "                                        "πDATA 20,17ππDATA "                                        "πDATA "                                        "πDATA "                                        "πDATA "             o            o             "πDATA " #  o     =========#=========     o   # "πDATA " #====             #            ======# "πDATA " #   ===   #       #      #   ===     # "πDATA " #     ====#==============#====       # "πDATA " #         #              #           # "πDATA " # o    #  #       o      #    o      # "πDATA " ===   =#=============================# "πDATA "        #                             # "πDATA "        #                             # "πDATA "        #                             # "πDATA " #      #             o      #   o    # "πDATA " #=============       =======#========= "πDATA " #                           #          "πDATA " #                           #        # "πDATA " #===============          ==#========# "πDATA " #              ===          #        # "πDATA " #                ===        #        # "πDATA " #   o              === o    #        # "πDATA " ======               =========     === "πDATA "                                        "πDATA "                                        "πDATA 37,22ππDATA "                                        "πDATA "                                        "πDATA "                                        "πDATA "                                        "πDATA "  o         #   o     o    #          o "πDATA " ===========#=====   ======#=========== "πDATA "            #              #            "πDATA "            #              #            "πDATA " o          #       #      #          o "πDATA " ===   =======   ===#==   =======   === "πDATA " +                  #                 + "πDATA " +                  #                 + "πDATA " +    #       o     #     o      #    + "πDATA " +   =#========   =====   =======#=   + "πDATA " +    #         o      o         #    + "πDATA " +    #                          #    + "πDATA " +    #                          #    + "πDATA " +    #         #      #         #    + "πDATA " +   ===========#======#===========   + "πDATA " +              #      #              + "πDATA "        o       #      #       o        "πDATA " o              #      #              o "πDATA " ====================================== "πDATA "                                        "πDATA "                                        "πDATA 21,13ππDATA "                                        "πDATA "                                        "πDATA "                                        "πDATA "       o      o         o      o        "πDATA " =#========   ====   ====   =========#= "πDATA "  #                                  #  "πDATA "  #                                  #  "πDATA "  #   o          o            #      #  "πDATA " ========   ==================#======== "πDATA "  +     ==                    #         "πDATA "         ==                   #         "πDATA "  o       ==  o    #     o    #     o   "πDATA " ==================#=================== "πDATA "  +                #                 +  "πDATA "                   #                    "πDATA "   o         o     #     o          o   "πDATA " ========   =======#========   ======== "πDATA "  +                #                 +  "πDATA "  +   o            #             o   +  "πDATA "  +  ===   ========#=========   ===  +  "πDATA "  +                #                 +  "πDATA "  +                #                 +  "πDATA "  +o               #                o+  "πDATA " ====================================== "πDATA "                                        "πDATA 20,12πDATA "STOP"ππSUB BulletπSTATIC B, PrevX, PrevY, xtep, ytep, px, py, elapsed, DontChaseπIF Delay = 1 THEN             'If the sub is being not being called by theπ                              'DrawGuy sub, there is no delay so it'llπ                              'have to delay itself.π   elapsed = elapsed + 1      'Does so by only executing every 25th CALLπ   IF elapsed < DartSpeed THEN  'or so.π      EXIT SUBπ   ELSEπ      elapsed = 0π   END IFπEND IFπIF ResetFlag = 1 THEN B = 0     'Player has started new level. RereadπIF B = 0 OR dead = 1 THEN          'The background or if first time called.π   IF INT(RND * 500) <> 99 THEN EXIT SUB  'Makes bullets come OCCASIONALLYπ   elapsed = 0                           'NOt one after another.π   DontChase = 0π   B = 1π   a = INT(RND * 2)           'Come from top or left side?π   IF a = 0 THEN          'If side,π      px = 2π      py = INT(RND * 180) + 2π      xtep = .2               'Y step value,π      ytep = 0                              'X step valueπ   ELSEπ      px = INT(RND * 290) + 2   'If top....π      py = 2π      xtep = 0π      ytep = .2π   END IFπ   PrevX = pxπ   PrevY = pyπ   GET (px, py)-(px + 1, py + 1), bgraph  'Gets background behind bulletπEND IF                                   'so it doesn't erase what's behind.πpx = px + xtep                        'Move it horiz or vert..πpy = py + ytepπPUT (PrevX, PrevY), bgraph, PSET   'Erase bullet and put back what was there.πPrevX = px                        'The previous position saved for the nextπPrevY = py                        'time.πGET (px, py)-(px + 1, py + 1), bgraph   'Saves background again.πLINE (px, py)-(px + 1, py + 1), 15, B   'Draws bulletπcx = px \ 8 + 1                        'Calculates the "text" (8x8) positionπcy = py \ 8 + 1                        'of the bulletπIF cx = x AND cy = y THEN           'If same as guy's position, smite him.π   CALL Dieπ   EXIT SUBπEND IFπIF x < cx OR y < cy THEN d = -1      'IF the bullet is on same line asπIF y > cy OR x > cx THEN d = 1       'guy, AND it has not already changedπIF cx = x AND DontChase = 0 THEN     'course, swerve directly to him.π   ytep = dπ   xtep = 0π   DontChase = 1                     'But it can only do it once.πSOUND 400, 1: SOUND 1000, 1πEND IFπIF cy = y AND DontChase = 0 THEN       'Same, but for vertically.π   ytep = 0π   xtep = dπ   DontChase = 1πSOUND 400, 1: SOUND 1000, 1πEND IFπIF PrevX > 290 OR PrevY > 180 OR PrevX < 2 OR PrevY < 2 THENπ   PUT (PrevX, PrevY), bgraph, PSETπ   PrevX = 0π   PrevY = 0                   'If offscreen, erase everything andπ   px = 0                      'prepare to start a new instance of theπ   py = 0                      'bullet on the next call. (B=0)π   B = 0πEND IFπEND SUBππSUB centre (y, t$)π'Centres something on the screen at the line YππLOCATE y, 20 - LEN(t$) / 2πPRINT t$;πππEND SUBππSUB ClearKeyBuffer (n)ππ'Clears the keyboard buffer by repeatedly reading in keys.ππFOR s = 1 TO nπ   a$ = INKEY$πNEXTππEND SUBππSUB Dieπ        π         DontDraw = 1  'Stop the bullet movement (in DrawGuy calls)π         snd = 0                    'No click sound on movement.π         FOR i = xy TO 200 STEP 3π            CALL DrawGuy(xx, i)       'Make him fall.π            SOUND 400 + (200 - i), .4π         NEXTπ         snd = 1π         SLEEP 1π         DontDraw = 0π         PLAY "t200o3 MF MN L4 c2ccc2d#ddcc<b>c"π         lives = lives - 1π         dead = 1              'Set death flagπ   πEND SUBππSUB DrawGuy (x, y)πSTATIC a, B, PrevX, PrevYπFOR s = 1 TO GuySpeed: NEXT     'Delays for fast computers.πIF ResetFlag = 1 THEN B = 0     'If next level reread backgroundπpx = x - 8πpy = y - 16πIF B = 0 THEN           'If first time called, read backgroundπ   B = 1                'behind the guy with GET so he doesn't erase itπ   PrevX = px           'or leave trails.π   PrevY = pyπ   GET (px, py)-(px + 15, py + 15), graphπEND IFπPUT (PrevX, PrevY), graph, PSET     'Put background back, erase guyπPrevX = pxπPrevY = pyπGET (px, py)-(px + 15, py + 15), graph    'Get background at next positionπa = a + .5                    'Move legsπIF a = 4 THEN a = 0πLINE (px + 3, py)-(px + 5, py + 2), 15, BFπLINE (px + 2, py + 3)-(px + 6, py + 6), 4, BF    'Draws guyπLINE (px + 4, py + 6)-(px + 4 - a, py + 13), 5πLINE (px + 4, py + 5)-(px + 5 + a, py + 13), 5πLINE (px + 4 - a, py + 14)-(px + 4 - a + 1, py + 15), 15, BFπLINE (px + 4, py + 14)-(px + 5 + a + 1, py + 15), 15, BFππIF DontDraw = 0 THENπ   Delay = 0              'Calls the bullet sub and tells it not to delayπ   CALL Bullet            'because we've already delayed.π   Delay = 1πEND IFππIF snd = 1 THEN SOUND 10000, .1    'The infamous click sound.πππEND SUBππSUB HighScoresπON ERROR GOTO CreateNewFile  'If file doesn't exist, branch there.πCLSππOPEN FileName$ FOR INPUT AS 1πON ERROR GOTO 0πFOR s = 1 TO 15π   INPUT #1, Name$(s)             'REad in scoresπ   INPUT #1, Score(s)πNEXTπCLOSE 1πFOR outside = 1 TO 15π   FOR inside = outside + 1 TO 15            'A bubble sort, just for you,π      IF Score(outside) < Score(inside) THEN 'Mrs. Gotovac.π         SWAP Score(outside), Score(inside)π         SWAP Name$(outside), Name$(inside)π      END IFπ   NEXTπNEXTπππPLAY "T128 O2 L4 MS MB G8>C8 G8 G8 <G8>C8 G8 G8 <G8>C8 D16 E16 F8 E16 D16 C2"πCOLOR 14πcentre 2, "High Scores"πCOLOR 3πPRINT : PRINTπFOR s = 1 TO 15π   LOCATE s + 3, 10π   PRINT Name$(s); TAB(22); Score(s); "  "πNEXTπLINE (68, 4)-(236, 144), 4, BπLINE (68, 20)-(236, 20), 4πClearKeyBuffer 15πIF TotalScore * 100 > Score(1) THENπ   COLOR 14π   centre 20, CHR$(2) + " NEW HIGH SCORE " + CHR$(2)π   PRINTπ   INPUT "Please enter your name: ", n$π   n$ = LEFT$(n$, 12)π   FOR s = 14 TO 1 STEP -1π      Name$(s + 1) = Name$(s)π      Score(s + 1) = Score(s)π   NEXTπ   Name$(1) = n$π   Score(1) = TotalScore * 100π   OPEN FileName$ FOR OUTPUT AS 1π   FOR s = 1 TO 15π      LOCATE s + 3, 10π      PRINT Name$(s); TAB(22); Score(s); "   "π      PRINT #1, Name$(s)π      PRINT #1, Score(s)π   NEXTπ   LINE (68, 4)-(236, 144), 4, Bπ   CLOSE 1πEND IFπππππWHILE INKEY$ = "": WENDππEND SUBππSUB paldef (c, r, g, B)π   'Redefines a colour to be another custom colour.π  π   OUT &H3C8, cπ   OUT &H3C9, rπ   OUT &H3C9, gπ   OUT &H3C9, BππEND SUBππSUB pandisplay (xp, yp)π'Makes the display instantly jump for earthquake effect.ππOUT &H3D4, 12: OUT &H3D5, ypπOUT &H3D4, 13: OUT &H3D5, xpπEND SUBππSUB UpdateScoreππ'Updates the scoreboard.ππLOCATE 25, 1πCOLOR 2: PRINT "Lives:";πCOLOR 14: PRINT lives;πCOLOR 2: PRINT TAB(11); "Points:";πCOLOR 14: PRINT Points * 100;πCOLOR 2: PRINT TAB(24); "Bonus:";πCOLOR 14: PRINT Bonus; "   ";ππEND SUBπSteven Hanov                   HANG PERSON                    [e-mail]              04-24-96 (00:00)       QB, QBasic, PDS        375  13482    HANGMAN.BAS DECLARE SUB centre (lc!, t$)πDECLARE SUB DrawGuy (parts!)πDECLARE SUB IntroScreen ()πDECLARE SUB BigPrint (t$, x!, y!, colour!, sc!)π'****************************************************************************π'*                          IDENTIFICATION                                  *π'*                                                                          *π'*                NAME:       Steven Hanov                                  *π'*                PROGRAM:    a:\progC.bas                                  *            *π'*                SCHOOL:     Cardinal Newman C. S. S.                      *π'*                TEACHER:    Miss Gotovac                                  *π'*                COMPUTER:   IBM/MS-DOS                                    *π'*                LANGUAGE:   QBASIC                                        *π'*                PERIOD:     LATE 20th CENTURY (Julian Calender)           *π'*                CLASS:      DPT 3A1 Period 2                              *π'*                DATE:       96/04/26                                      *π'*                                                                          *π'****************************************************************************ππ'****************************************************************************π'*                       PROGRAM ANALYSIS                                   *π'*                                                                          *π'* This program will simulate the game of HANG PERSON. The user may select  *π'* from multiple catagories. The hanging of the person will be shown in     *π'* steps.                                                                   *π'****************************************************************************ππ'****************************************************************************π'*                       VARIABLE DICTIONARY                                *π'****************************************************************************πDIM p$(22)πDIM words(5, 25) AS STRING, Cats(5) AS STRING, wcount(5), ccountπDIM hints(5, 25) AS STRINGπDIM SHARED char(32 TO 126, 8, 16), m$(12)ππ'p$ contains the lines of musicπ'word$ contains the words in each catagory (cat,word#)π'Cats contains the names of the catagoriesπ'wcount contains the number of words in each catagoryπ'ccount counts the number of catagoriesπ'hints is like words but has the hints.π'char contains the character information for each pixel (0=OFF,15=ON)π'm$ contains the possible exit messagesππ'****************************************************************************π'*                              MAIN                                        *π'****************************************************************************πRANDOMIZE TIMERπON PLAY(3) GOSUB musicππSCREEN 12πCLSπLOCATE 2, 1πPRINT "Please wait..."πCOLOR 15πFOR s = 32 TO 126π   LOCATE 1, 1: PRINT CHR$(s)                 'Scans all characters intoπ   FOR y = 1 TO 16                            'array CHAR().π      FOR x = 1 TO 8π         char(s, x, y) = POINT(x - 1, y - 1)π      NEXTπ   NEXTπ   IF s = 95 THEN char(s, 8, 14) = 0         'Makes "_" shorterπNEXT                                         'so underline is separatedππGOSUB music                        'Starts musicπPLAY ONππππCALL IntroScreenπDOπ   READ c$π   IF c$ = "ENDDATA" THEN EXIT DOπ   ccount = ccount + 1π   Cats(ccount) = c$π   DOπ      READ w$                                'Reads in all theπ      IF w$ = "ENDCAT" THEN EXIT DO          'dataπ      wcount(ccount) = wcount(ccount) + 1π      words(ccount, wcount(ccount)) = w$π      READ h$π      hints(ccount, wcount(ccount)) = h$π   LOOPπLOOPππReStart:ππLINE (190, 120)-(440, 340), 0, BF                'clears a portion if theπCOLOR 14                                                      'screenπFOR s = 1 TO ccountπ   LOCATE 100 \ 16 + 1 + s * 2, 200 \ 8 + 1      'Prints menu of catagoriesπ   PRINT Cats(s)πNEXTπitem = 1πpitem = 1πDOπ   LINE (200, 100 + (item * 2) * 16 - 8)-(430, 100 + (item * 2) * 16 + 20 - 8), 4, Bπ   DOπ      a$ = INKEY$                         'Filters out unacceptable keypressesπ   LOOP UNTIL (a$ = CHR$(0) + CHR$(80)) OR (a$ = CHR$(0) + CHR$(72)) OR a$ = CHR$(13)π   IF a$ = (CHR$(0) + CHR$(80)) AND (item < ccount) THENπ      item = item + 1                      'user pressed downπ   ELSEIF (a$ = CHR$(0) + CHR$(72)) AND (item > 1) THENπ      item = item - 1                      'user pressed upπ   END IFπ   LINE (200, 100 + (pitem * 2) * 16 - 8)-(430, 100 + (pitem * 2) * 16 + 20 - 8), 0, Bπ   pitem = item                         'Clears previous box,draws newπLOOP UNTIL a$ = CHR$(13)         'Loop until ENTER pressedππLINE (100, 120)-(540, 400), 0, BFπsofar$ = ""                              'What user has so far ("Th_s w_rd")πalpha$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"    'What they can choose fromπcw = INT(RND * wcount(item) + 1)          'Pick random wordπword$ = words(item, cw)πh$ = hints(item, cw)                    'The hintπToBeFound = LEN(word$)                  'Howmany letters they have to findπFOR s = 1 TO LEN(word$)π   a$ = "_"                             'Puts in punctuation - don't haveπ   b = ASC(MID$(LCASE$(word$), s, 1))            'to guess /-*: etc.π   IF b < 97 OR b > 122 OR b = 32 THEN a$ = CHR$(b): ToBeFound = ToBeFound - 1π   sofar$ = sofar$ + a$πNEXTπ      πLINE (500, 170)-(520, 390), 6, BFπLINE (400, 170)-(520, 190), 6, BFππCALL BigPrint(sofar$, 108, 128, 3, 2)πLOCATE 24, 16: COLOR 14: PRINT "Letters to choose from:"πtries = 1πlettersfound = 0πDOπ   LOCATE 25, 16: COLOR 4: PRINT alpha$   'Prints letters to choose fromπ   CALL DrawGuy(tries)                   'Draws guyπ   ok = 0                                'Flag-user picked valid letterπ   DOπ      DOπ         b = 0                                 'Filters out all but alphabetπ         a$ = INKEY$π         IF a$ <> "" THEN b = ASC(LCASE$(a$))π      LOOP UNTIL b > 96 AND b < 123π      b = b - 96                      'Gets number of alphabet (a=1, z=26)π      IF MID$(alpha$, b, 1) <> "-" THEN ok = 1   'Checks if its already pickedπ   LOOP UNTIL ok = 1          'Loops out when user picks new letterπ   MID$(alpha$, b, 1) = "-"    'Makes it a "-"π   found = 0π   FOR s = 1 TO LEN(word$)π      letter = ASC(MID$(LCASE$(word$), s, 1))π      IF letter = b + 96 THEN              'If found,π         found = 1                         'replaces letters in wordπ         lettersfound = lettersfound + 1π         c$ = CHR$(letter)π         IF ASC(MID$(word$, s, 1)) < 96 THEN c$ = UCASE$(c$)π         MID$(sofar$, s, 1) = c$π         CALL BigPrint(c$, 108 + (s - 1) * 16, 128, 3, 2)π      END IFπ   NEXTπ   IF found = 0 THEN tries = tries + 1π   IF tries = 6 THENπ      LOCATE 21, 16: PRINT "HINT:"π      LOCATE 22, 16: PRINT h$π   END IFπLOOP UNTIL lettersfound = ToBeFound OR tries = 7ππIF tries = 7 THENπ   CALL DrawGuy(7)π   LOCATE 15, 16: COLOR 14: PRINT "You LOSE!"π   LOCATE 16, 16: PRINT "The parts of your body"π   LOCATE 17, 16: PRINT "have all decomposed."π   CALL BigPrint(word$, 108, 128, 3, 2)πELSEπ   LOCATE 15, 17: COLOR 14: PRINT "You WIN!"πEND IFππLOCATE 19, 16: PRINT "Play again (Y/N)?"πDOπ   a$ = INKEY$π   IF a$ <> "" THEN a$ = UCASE$(a$)πLOOP UNTIL a$ = "Y" OR a$ = "N"π   LINE (100, 120)-(540, 400), 0, BFπ   DRAW "c6 BM0,350 ta60 r100 ta-60 r70 ta20 r80 ta40 r100 ta -10 r50"π   DRAW "ta5 r70 ta-40 r100 ta30 r90 ta70 r100 ta20 r200"π   PAINT (110, 130), 4, 6π   PAINT (530, 390), 6, 4πIF a$ = "Y" THEN GOTO ReStartπLINE (130, 170)-(510, 230), 0, BFπCOLOR 3πm$(1) = "Press enter to activate the electric chair."πm$(2) = "Press enter to release the chlorine gas."πm$(2) = "Press enter to release the flying baracudas."πm$(3) = "There's a demon around the next corner!"πm$(4) = "Press enter to raise the GST by 18%!"πm$(5) = "Press enter to launch the nuclear warheads."πm$(6) = "Press enter to format hard disk."πm$(7) = "Press enter to nullify all your credit cards."πLOCATE 13, 18: PRINT m$(FIX(RND * 6) + 1)πππππDO WHILE INKEY$ = "": LOOPπENDπDATA TV ShowsπDATA Seinfeld,Don't you wish you had a sein?,X-Files,Check your files for this one.πDATA "Star Trek: Voyager",Take a trek to the stars, Friends,The opposite of enemiesπDATA Masterpiece Theater,A theater of works of artπDATA Mr. Rogers Neighborhood,Everyone wants this neighborπDATA Sesame Street,Do you live on this street?πDATA Polka Dot Door,Open the door to dots!πDATA Animaniacs,These guys are animated maniacs.πDATA Barney and Friends,"I love you, you love me..."πDATA Traders,These don't deal in the fur trade...πDATA Cosby Show,Bill stars here..., Road to Avonlea, Think PEI.πDATA Home Improvement,Better your abode.πDATA The Red Green Show,Christmas ColoursπDATA Reboot,Don't press reset.πDATA Earth 2,A sequel to the planetπDATA SeaQuest DSV,Searching the oceanπDATA Cheers,A bar, ER,Think hospitals, Sliders,Banana peel!, ENDCATππDATA ComputersπDATA Hard Disk,This one too HARD for you?πDATA Monitor,Its staring you in the face!πDATA RAM,Memory,ROM,MemoryπDATA System Unit,The BRAINπDATA Floppy Disk,Media,Keyboard,You're using it now,Modem,TelephonesπDATA Mouse,Look out for the cat!πDATA Microsoft,These guys play monopoly.πDATA Binary Numbers,"01010101010"πDATA Hacker,"Not with an axe, but a mouse!"πDATA Uninterruptable Power Supply,When lightning strikes...UPSπDATA QBasic,Programming LanguageπDATA ENDCATπDATA Internet LingoπDATA Hypertext Markup Language,HTML,Universal Resource Locator,URLπDATA Home Page,You can't go home now,USENET,Do you use it?πDATA article,read 'em or write 'em.πDATA e-mail,have you send any lately?πDATA Surf the Web,Water metaphorπDATA Gopher,Small animalπDATA Wais,Oh let me count the ways!πDATA Archie,Think comics.πDATA Jughead,Eats a lot.πDATA Veronica,The rich one.πDATA Netscape,A browserπDATA Mosaic,A old browserπDATA File Transfer Protocol,FTPπDATA Point-To-Point Protocol,PPPπDATA SLIP Connection,Don't fall on the banana!πDATA World Wide Web,WWWπDATA ENDCATπDATA ENDDATAππππ'****************************************************************************π'*                           SUBROUTINES                                    *π'****************************************************************************πππmusic:πIF l = 0 THENπ   p$(1) = "O1T128L16MBee p16 eee e8 ee p16 e8 a#8 e"π   p$(2) = "e8 eee e8 ee p16 e8 b p16 ee"π   p$(3) = "p16 eee e8 ee p16 e8 >c8< eee"π   p$(4) = "e p16 ee p16 e e8 >c#< p17 b p16 ee p16 e8"π   p$(5) = "ee p16 ee p16 e8 a# e e8 e e8"π   p$(6) = "ee p16 ee p16 e8 b p16 eee e8 e"π   p$(7) = "e p16 ee p16 e8 >c<e e8 ee p16 ee"π   p$(8) = "p16 e e8 >c# c <b16 >e"π   p$(9) = "o2 ML b b2 b4. >c8 c2 c4 c c#8 c# c#2"π   p$(10) = "c#4 d2 d8. c p16 <b p16 b MN"π   p$(11) = "O1" + p$(5)π   p$(12) = p$(6)π   p$(13) = p$(7)π   p$(14) = p$(8)π   p$(15) = "O3 bgegb>c<bge<bg>e"π   p$(16) = "gf#ecegage>c<gege>c<b"π   p$(17) = "ag<bgegb>egbgf#ebag"π   p$(18) = "be<gab>e<b>g>dc#<bgcp16<bp16"π   p$(19) = "gbage<b>gb>c<babge<b>>e"π   p$(20) = "gf#eage<bgb>egbageg<b"π   p$(21) = "ge<gb>egb>egbgeg<bge"π   p$(22) = "g<b>egbgb>dcp16<bp16"πEND IFππl = l + 1: IF l = 23 THEN l = 1πPLAY p$(l)πRETURNππSUB BigPrint (t$, x, y, colour, sc)ππFOR c = 1 TO LEN(t$)πFOR yp = 1 TO 16π   FOR xx = 1 TO 8π      xp = (c - 1) * 8 + xxπ      IF char(ASC(MID$(t$, c, 1)), xx, yp) = 15 THENπ         LINE (x + (xp * sc), y + (yp * sc))-(x + (xp * sc) + sc, y + (yp * sc) + sc), colour, BFπ      END IFπ   NEXTπNEXTπNEXTπππEND SUBππSUB centre (lc, t$)πLOCATE lc, 40 - LEN(t$) \ 2πPRINT t$πEND SUBππSUB DrawGuy (parts)πLINE (385, 302)-(407, 390), 0, BFπLINE (435, 302)-(412, 390), 0, BFπLINE (385, 245)-(435, 300), 0, BFπLINE (382, 245)-(370, 310), 0, BFπLINE (437, 245)-(448, 310), 0, BFπPAINT (410, 220), 0πIF parts = 7 THEN EXIT SUBπON parts GOTO Leg1, Leg2, Body, Arm1, Arm2, HeadππLeg1:πLINE (385, 302)-(407, 390), 1, BFπLeg2:πLINE (435, 302)-(412, 390), 1, BFππBody:πLINE (385, 245)-(435, 300), 4, BFππArm1:πLINE (382, 245)-(370, 310), 4, BFππArm2:πLINE (437, 245)-(448, 310), 4, BFππHead:πCIRCLE (410, 220), 20, 14πPAINT (410, 220), 14ππππEND SUBππSUB IntroScreenπPAINT (1, 1), 4πDRAW "c6 BM0,350 ta60 r100 ta-60 r70 ta20 r80 ta40 r100 ta -10 r50 ta5 r70"πDRAW "ta-40 r100 ta30 r90 ta70 r100 ta20 r200"πPAINT (10, 360), 6πCALL BigPrint("H", 100, 20, 14, 6)πCALL BigPrint("ang Perso", 150, 20, 14, 4.5)πCALL BigPrint("N", 480, 20, 14, 6)πLINE (100, 120)-(540, 400), 0, BFππCOLOR 5πcentre 10, "Written by Steven Hanov ([e-mail])"πCOLOR 7πcentre 12, "For computer class at"πcentre 13, "Cardinal Newman High School"πCOLOR 1πcentre 16, "The object of the game is to guess what a"πcentre 17, "word is by picking the letters. This must"πcentre 18, "done before the person's body is fully"πcentre 19, "decomposed. If you can do it, the body can"πcentre 20, " possibly be reanimated."πCOLOR 14πcentre 23, "Press any key to start."πππDO WHILE INKEY$ = "": LOOPπ   LINE (100, 120)-(540, 400), 0, BFπ   DRAW "c6 BM0,350 ta60 r100 ta-60 r70 ta20 r80 ta40 r100 ta -10 r50"π   DRAW "ta5 r70 ta-40 r100 ta30 r90 ta70 r100 ta20 r200"π   PAINT (110, 130), 4, 6π   PAINT (530, 390), 6, 4πEND SUBπSteven Hanov                   PICK A NUMBER                  [e-mail]              04-11-96 (00:00)       QB, QBasic, PDS        112  5519     PICKNUM.BAS '****************************************************************************π'*                          IDENTIFICATION                                  *π'*                                                                          *π'*                NAME:       Steven Hanov                                  *π'*                PROGRAM:    a:\picknum.bas                                *            *π'*                SCHOOL:     Cardinal Newman C. S. S.                      *π'*                TEACHER:    Miss Gotovac                                  *π'*                COMPUTER:   IBM/MS-DOS                                    *π'*                LANGUAGE:   QBASIC                                        *π'*                PLANET:     Earth (Sol-III)                               *π'*                PERIOD:     LATE 20th CENTURY (Gregorian Calender)        *π'*                CLASS:      DPT 3A1 Period 2                              *π'*                DATE:       April 11, 1996                                *π'*                                                                          *π'****************************************************************************ππ'****************************************************************************π'*                       PROGRAM ANALYSIS                                   *π'*                                                                          *π'* This program will allow a user to entertain him or herself in a mindless *π'* and simple guessing game involving the extropolation of an unknown       *π'* numeric variable between 1 and 20 using no data other than that of an    *π'* approximate "high or lower" after each attempt.                          *π'****************************************************************************πDECLARE SUB PalDef (c!, r!, g!, b!)ππ'****************************************************************************π'*                       VARIABLE DICTIONARY                                *π'****************************************************************************ππ'A$ - a temperary variable used in various operations.π'num - the random number the computer has picked.π'y - used in for/next loops to fill background colourπ'c- used in fill-background loop to determine gradient fill colourπ'n - the number the user has picked.π'guess - the number of guesses the user takesππ'****************************************************************************π'*                              MAIN                                        *π'****************************************************************************ππSCREEN 13              '320x200, 1 page, 256 coloursπRANDOMIZE TIMERπCLSπnum = INT(RND * 20) + 1        'picks random numberπFOR y = 1 TO 200π   c = INT((y / 200) * 50)       'Picks gradient value, from 1 to 50π   LINE (0, y)-(320, y), c      'Draws a horizontal line of colour cπ   CALL PalDef(c, c, 0, 0)      'Redefines palette do make gradient fillπNEXTπCALL PalDef(0, 63, 0, 0)        'Makes default background colour REDπCALL PalDef(51, 63, 50, 0)      'Makes colour #51 yellowπDOπ   LINE (20, 20)-(200, 160), 0, BF   'Draws red boxπ   LOCATE 4, 4π   PRINT "Guess which number"π   LOCATE 5, 4: PRINT "the computer has"π   LOCATE 6, 4: PRINT "picked. The arrow on "π   LOCATE 7, 4: PRINT "the side will tell"π   LOCATE 8, 4: PRINT "you whether to guess"π   LOCATE 9, 4: PRINT "higher or lower."π      DOπ         LOCATE 12, 4: INPUT "> ", a$: n = VAL(a$)   'Screens out lettersπ         IF n > 20 OR n < 1 THENπ            LOCATE 14, 4: PRINT "The number must be"π            LOCATE 15, 4: PRINT "between 1 and 20."π         END IFπ      LOOP UNTIL n <= 20 AND n >= 1     'Loops until number is acceptableπ   LINE (230, 20)-(280, 170), 51, BF    'Yellow box clearedπ   LINE (250, 40)-(260, 140), 1, BF     'draws base of arrowπ   LOCATE 21, 31: PRINT n               'print guessed number in yellow boxπ   IF n > num THENπ      LINE (240, 140)-(270, 140), 1π      LINE -(255, 150), 1              'Draws down arrowπ      LINE -(240, 140), 1π      PAINT (242, 141), 1π   ELSEIF n < num THENπ      LINE (240, 40)-(270, 40), 1π      LINE -(255, 30), 1             'Draws up arrowπ      LINE -(240, 40), 1π      PAINT (242, 39), 1π   END IFπ   guess = guess + 1               'increment guessesπLOOP UNTIL n = numπLINE (230, 20)-(280, 160), 51, BF       'Clears yellow boxπFOR y = 1 TO 200π   c = INT((y / 200) * 50)         'Redraws gradient fill background,π   LINE (0, y)-(320, y), c         'but in yellow colour motifπ   CALL PalDef(c, c, c, 0)πNEXTπCALL PalDef(0, 63, 63, 0)          'Redefines background colour to be yellowπLINE (50, 50)-(270, 150), 0, BFπs$ = "y"πIF guess > 1 THEN s$ = "ies"      'Makes "try" grammatorically correctπLOCATE 9, 8: PRINT "You correctly guessed that"πLOCATE 10, 8: PRINT "the number was"; numπLOCATE 12, 8: PRINT "It took you"; guess; "tr"; s$; "."ππWHILE INKEY$ = "": WENDπENDπ'****************************************************************************π'*                           SUBROUTINES                                    *π'****************************************************************************π'PalDef(c,r,g,b) redefines colour #c to have the red, green and blue valuesπ'                 R,G, and B respectively             ππSUB PalDef (c, r, g, b)π   OUT &H3C8, cπ   OUT &H3C9, rπ   OUT &H3C9, gπ   OUT &H3C9, bπEND SUBπThe ABC Programmer             TOAD HOP (FROGGER CLONE)       Adapted from Pascal code       07-15-96 (16:16)       QB, QBasic, PDS        414  14071    TOADHOP.BAS '==============================================================π' TOAD HOP (Frogger Clone) Programmed by William Yu (07-15-96)π'  Adapted from Pascal code (Frogger v0.90) by Jonas Maebeπ'  Thanks for the tiles! :)π'π' System Recommendations:π'    486/16MHz or better or compile for best performanceπ'    EGA or betterπ'π' I have never played the actual Frogger game, so I have noπ' idea if this is even close to it :)π'π' Improvements (Just some suggestions)π' ------------------------------------π'    Levels!  Try removing some of the cars or turtleπ'             and adding them later as the level increases.π'             As well as the speed of course.π'    Score?   Have frogger pick up misc. material laying onπ'             the street or something <shrug>.π' Background? Because of my crude collision detection routine,π'             you might want to limit this.π'--------------------------------------------------------------ππDEFINT A-ZπDECLARE SUB UpDate.Sprite ()πDECLARE SUB Initialize.Sprites ()πDECLARE SUB Draw.Sprite (Sprite() AS INTEGER, XCor%, YCor%)πDECLARE SUB Read.Sprite (Sprite() AS INTEGER)πDECLARE SUB Draw.Background ()πDECLARE SUB Display.Lives ()ππDIM SHARED Frog(100) AS INTEGERπDIM SHARED Car1(100) AS INTEGERπDIM SHARED Car2(100) AS INTEGERπDIM SHARED Car3(100) AS INTEGERπDIM SHARED Car4(100) AS INTEGERπDIM SHARED Turtle(100) AS INTEGERπDIM SHARED Turtle2(100) AS INTEGERπDIM SHARED Turtle3(100) AS INTEGERπDIM SHARED XCor, XCor2, XCor3, XCor4, XCor5       ' You can modify theπDIM SHARED YCor, YCor2, YCor3, YCor4, YCor5       ' value of any ofπDIM SHARED Speed1, Speed2, Speed3, Speed4, Speed5 ' these variablesπDIM SHARED FrogX, FrogY, Lives, Clock             ' if you want to.πDIM SHARED Finished, Hit                          ' Boolean variablesππTIMER ON                           ' Remove this if you do not wantπON TIMER(1) GOSUB DecreaseTime     ' to impose a time limitππCONST False = 0πCONST True = NOT FalseπCONST Apart = 20     ' Distance from one lane to the next (10 < Apart < 30)πCONST Seconds = 30   ' Maximum allotted time to complete levelππClock = SecondsπLives = 3            ' Number of lives REMAINING.  As many as you want.π                     ' Maximum of four will be displayed, the rest are not.ππYCor = 160                  ' Starting position of first sprite  'πYCor2 = YCor - Apart        ' so on and so forth                 'πYCor3 = YCor - (Apart * 2)  ' .                                  'πYCor4 = YCor - (Apart * 3)  ' .                                  'πYCor5 = YCor - (Apart * 5)  ' You can add more if you wish       'ππSCREEN 7, , 1, 0               ' Start by hiding everythingπPRINT "Initializing data..."   ' Just so the user doesn't fall asleep...πPCOPY 1, 0                     ' Display the message on the visual pageππInitialize.Sprites  ' Read in all the sprite dataπDraw.Background     ' Spiffy background, create your own artistic sceneππFrogX = 130: FrogY = YCor + Apart    ' Starting position of your spiffy frogπDraw.Sprite Frog(), FrogX, FrogY     ' Let's draw the handsome dudeππI = -60                              ' Okay, some weird values here.πI2 = 0                               ' These are for the sprites toπI3 = -80                             '  scroll across the screen smoothly.πI4 = 0                               ' Mostly guess & test values hereπI5 = 0                               '  but it works.πXCor = I                             ' The real location of each spriteπXCor2 = I2                           '  to detect collision.πXCor3 = I3πXCor4 = I4πXCor5 = I5πUpDate.Sprite                        ' Draws all the sprites onto the screenππSpeed1 = 2                           ' Speed of sprite one and so on...πSpeed2 = -3                          ' (-) Negative = Sprite moves leftπSpeed3 = 6                           ' (+) Positive = Sprite moves rightπSpeed4 = -2                          ' Increase numbers for a fasterπSpeed5 = -2                          ' and much more challenging game!ππFinished = False                     ' Game just started.ππDO                                   ' Main Game Loopπ    I = I + Speed1: XCor = I         ' Let's move the spritesπ    IF XCor >= 32 THEN I = -83π    I2 = I2 + Speed2: XCor2 = I2π    IF XCor2 <= -69 THEN I2 = 45π    I3 = I3 + Speed3: XCor3 = I3π    IF XCor3 > 60 THEN I3 = -27π    I4 = I4 + Speed4: XCor4 = I4π    IF XCor4 <= -64 THEN I4 = 50π    I5 = I5 + Speed5: XCor5 = I5π    IF XCor5 <= -32 THEN I5 = 48π    UpDate.Sprite                    ' Update the screen to reflect new valuesπ    IF Finished THEN                 ' Really not necessary :)π       PCOPY 2, 1                    ' You can end the game here.π       LOCATE 2, 16: COLOR 2π       PRINT "Please go back!"; CHR$(34); "   "π       PCOPY 1, 2π       Finished = NOT Finishedπ    END IFπ    IF Hit = True THENπ      LINE (20, 65)-(250, 85), 0, BFπ      LINE (20, 65)-(250, 85), 15, Bπ      IF Clock <= 0 THENπ        LOCATE 10, 5: COLOR 13: PRINT "Sorry, time's up Mr. Slug!"π      ELSEπ        IF FrogY = YCor5 THENπ          IF FrogX <= -1 THENπ            LOCATE 10, 5: COLOR 11: PRINT "You went over a waterfall!"π          ELSEπ            LOCATE 10, 5: COLOR 11: PRINT "Try staying ON their backs"π          END IFπ        ELSEπ          LOCATE 10, 5: COLOR 14: PRINT "Attention: Look both ways!"π        END IFπ      END IFπ      PCOPY 1, 0π      T! = TIMERπ      DOπ      LOOP UNTIL INKEY$ = "" AND TIMER - T! > 1.5π      Clock = Seconds                     ' Reset Clockπ      FrogY = YCor + Apart: FrogX = 130   ' Restart froggerπ      Lives = Lives - 1                   ' Decrease livesπ      IF Lives = -1 THEN EXIT DO          ' If no more, then game overπ      PCOPY 2, 1π      LINE (271, 0)-(319, 11), 0, BFπ      Display.Livesπ      PCOPY 1, 2π    END IFπLOOP                                 ' LOOP Until FinishedππSCREEN 7, , 0, 0                     ' Funky ending screenπRANDOMIZE TIMERπDOπ  X = INT(RND * 320) - 5π  Y = INT(RND * 206) - 5π  PSET (X, Y), 0π  IF K& > 25000 THENπ    LINE (X - 1, Y - 1)-(X + 10, Y + 10), 0π    LINE (X, Y)-(X - 10, Y - 10), 0π  END IFπ  IF K& > 37500 THEN LINE (X - 1, Y - 1)-(X + 10, Y + 10), 0, BFπ  K& = K& + 1πLOOP UNTIL INKEY$ <> "" OR K& > 40000πCLSπLOCATE 1, 1: PRINT "Thanks for playing!"πENDππDecreaseTime:π  Clock = Clock - 1πRETURNππ' FroggerπDATA 00,00,00,00,02,02,00,00,00,00πDATA 00,00,00,12,10,10,12,00,00,00πDATA 00,10,00,00,10,10,00,00,10,00πDATA 00,00,10,10,10,02,10,10,00,00πDATA 00,00,00,10,02,10,10,00,00,00πDATA 00,00,00,10,10,02,10,00,00,00πDATA 00,00,00,10,02,10,10,00,00,00πDATA 00,00,10,10,10,02,10,10,00,00πDATA 00,10,00,10,10,10,10,00,10,00πDATA 00,00,00,00,10,10,00,00,00,00ππ' Normal CarπDATA 00,00,00,00,00,00,00,00,00,00πDATA 00,00,00,00,00,00,00,00,00,00πDATA 00,00,00,12,12,12,00,00,00,00πDATA 00,00,12,04,11,11,11,00,00,00πDATA 12,12,12,12,04,12,12,12,12,00πDATA 04,08,08,08,04,04,08,08,08,04πDATA 00,00,07,00,00,00,00,07,00,00πDATA 00,00,00,00,00,00,00,00,00,00πDATA 00,00,00,00,00,00,00,00,00,00πDATA 00,00,00,00,00,00,00,00,00,00ππ' Flat CarπDATA 00,00,00,00,00,00,00,00,00,00πDATA 00,00,07,07,00,00,00,07,07,00πDATA 00,01,09,09,01,01,01,09,09,00πDATA 14,01,09,09,09,09,08,08,09,09πDATA 01,09,09,09,09,15,09,09,08,09πDATA 01,09,09,09,09,15,09,09,08,09πDATA 14,01,09,09,09,09,08,08,09,09πDATA 00,01,09,09,01,01,01,09,09,00πDATA 00,00,07,07,00,00,00,07,07,00πDATA 00,00,00,00,00,00,00,00,00,00ππ' Race CarπDATA 00,00,00,00,00,00,00,00,00,00πDATA 12,00,07,08,00,00,00,00,00,00πDATA 12,00,07,08,00,00,07,00,12,04πDATA 12,00,04,04,12,04,08,00,12,04πDATA 12,04,04,12,12,12,12,12,12,04πDATA 12,00,04,04,12,04,08,00,12,04πDATA 12,00,07,08,00,00,07,00,12,04πDATA 12,00,07,08,00,00,00,00,00,00πDATA 00,00,00,00,00,00,00,00,00,00πDATA 00,00,00,00,00,00,00,00,00,00ππ' BulldozerπDATA 00,00,00,00,00,00,00,00,00,00πDATA 00,14,14,00,00,00,00,00,00,00πDATA 00,07,08,14,00,07,08,00,07,08πDATA 00,07,08,00,14,14,14,14,14,08πDATA 00,07,08,00,00,14,08,07,14,08πDATA 00,07,08,00,14,14,06,09,14,08πDATA 00,07,08,00,00,14,08,07,14,08πDATA 00,07,08,00,14,14,14,14,14,08πDATA 00,07,08,14,00,07,08,00,07,08πDATA 00,14,14,00,00,00,00,00,00,00ππ' TurtleπDATA 00,00,00,05,00,00,00,00,05,00πDATA 00,00,00,00,05,05,05,05,00,00πDATA 00,00,05,06,06,06,05,06,05,00πDATA 12,05,05,05,06,05,06,05,06,05πDATA 00,03,06,06,06,06,06,06,06,05πDATA 00,03,05,05,06,06,06,05,06,05πDATA 12,05,05,06,05,06,06,06,05,05πDATA 00,00,05,05,06,06,06,05,05,00πDATA 00,00,00,00,05,05,05,05,00,00πDATA 00,00,00,05,00,00,00,00,05,00ππ' Turtle Half Under WaterπDATA 00,00,00,00,00,00,00,00,00,00πDATA 00,00,00,00,00,00,00,00,00,00πDATA 00,00,00,06,06,06,05,06,00,00πDATA 12,00,05,05,06,05,06,05,06,00πDATA 00,00,06,06,06,06,06,06,06,00πDATA 00,00,05,05,06,06,06,05,06,00πDATA 12,00,05,06,05,06,06,06,05,00πDATA 00,00,00,05,06,06,06,05,00,00πDATA 00,00,00,00,00,00,00,00,00,00πDATA 00,00,00,00,00,00,00,00,00,00ππ' Turtle Under WaterπDATA 00,00,00,00,00,00,00,00,00,00πDATA 00,00,00,00,00,00,00,00,00,00πDATA 00,00,00,00,00,00,00,00,00,00πDATA 00,00,00,00,06,05,06,00,00,00πDATA 00,00,00,06,06,06,06,06,00,00πDATA 00,00,00,05,06,06,06,05,00,00πDATA 00,00,00,00,05,06,06,00,00,00πDATA 00,00,00,00,00,00,00,00,00,00πDATA 00,00,00,00,00,00,00,00,00,00πDATA 00,00,00,00,00,00,00,00,00,00ππSUB Display.LivesππIF Lives > 4 THEN L = 4 ELSE L = LivesπFOR I = 1 TO Lπ  Draw.Sprite Frog(), 263 + I * 12, 1πNEXT IππEND SUBππSUB Draw.BackgroundππLINE (0, 0)-(270, 199), 14, BπLINE (1, 198)-(269, 175), 8, BFπLOCATE 2, 2: COLOR 2πPRINT "Mother Toad: "; CHR$(34); "Please come home!"; CHR$(34)πLINE (1, YCor5 - 6)-(269, YCor5 + 15), 1, BFπLINE (1, YCor5 + 15)-(269, YCor4 - 7), 8, BFπLINE (1, YCor5 - 6)-(269, YCor5 - 26), 2, BFπDOπ  RANDOMIZE TIMERπ  Y = ((YCor5 - 6) - (YCor5 - 26) + 1) * RND + (YCor5 - 26)π  X = RND * 269π  PSET (X, Y), 10π  N = N + 1πLOOP UNTIL N = 100πDisplay.LivesπPCOPY 1, 2     ' Save BackgroundππEND SUBππSUB Draw.Sprite (Sprite() AS INTEGER, XCor, YCor)ππI = 0πFOR Y = 1 TO 10π  FOR X = 1 TO 10π    I = I + 1π    IF Sprite(I) > 0 THEN PSET (XCor + X - 1, YCor + Y - 1), Sprite(I)π  NEXT XπNEXT YππEND SUBππSUB Initialize.SpritesππRead.Sprite Frog()πRead.Sprite Car1()πRead.Sprite Car2()πRead.Sprite Car3()πRead.Sprite Car4()πRead.Sprite Turtle()πRead.Sprite Turtle2()πRead.Sprite Turtle3()πCLSππEND SUBππSUB Read.Sprite (Sprite() AS INTEGER)ππI = 0πFOR Y = 1 TO 10π  FOR X = 1 TO 10π    I = I + 1π    READ Sprite(I)π    IF Sprite(I) > 0 THEN PSET (X, Y), Sprite(I)π  NEXT XπNEXT YππEND SUBππSUB UpDate.SpriteππLINE (0, 0)-(319, 199), 0, BF  ' Clear the screen for next updateπPCOPY 2, 1                     ' Restore the saved backgroundππIF XCor5 < 5 OR XCor5 > 25 THEN Under = 1πIF XCor5 < -15 OR XCor5 > 35 THEN Under = 2πIF XCor5 < -25 THEN Under = 3πIF XCor5 > 5 AND XCor5 < 30 THEN Under = 0πIF FrogY = YCor5 THEN FrogX = FrogX + Speed5  ' Frog on Turtle's backπHit = False: NoMore = Falseπ   πFOR Y = 1 TO 4π   IF NOT NoMore THEN A$ = INKEY$   ' Depending upon the position of Froggerπ   FOR X = 1 TO 3π     IF A$ <> "" AND NOT Hit THENπ       IF LEN(A$) > 1 THEN Char = -ASC(RIGHT$(A$, 1)) ELSE Char = ASC(A$)π          SELECT CASE Charπ            CASE 27π               ENDπ            CASE -72  ' Upπ               IF FrogY > YCor5 - Apart THENπ                 FrogY = FrogY - Apartπ                 IF FrogY = YCor5 - Apart THEN Finished = Trueπ               END IFπ            CASE -75  ' Leftπ               IF FrogX > 9 THENπ                 FrogX = FrogX - 10π               END IFπ            CASE -77  ' Rightπ               IF FrogX < 260 THENπ                 FrogX = FrogX + 10π               END IFπ            CASE -80  ' Downπ               IF FrogY < 200 - Apart THENπ                 FrogY = FrogY + Apartπ               END IFπ          END SELECTπ          A$ = ""π     END IFπ     ' Cheap way of detecting a collisionπ     IF (FrogY < YCor + Apart) AND (FrogY > YCor - (Apart * 4)) THENπ       A = POINT(FrogX + 1, FrogY + 5)π       B = POINT(FrogX + 8, FrogY + 5)π       C = POINT(FrogX + 5, FrogY + 5)π       IF (A OR B OR C) > 0 THEN Hit = Trueπ     END IFπ     IF FrogY = YCor5 THEN NoMore = True  ' Frogger is on the riverπ     Draw.Sprite Car1(), XCor, YCorπ     Draw.Sprite Car2(), XCor2, YCor2π     Draw.Sprite Car3(), XCor3, YCor3π     Draw.Sprite Car4(), XCor4, YCor4π     IF Under = 1 THEN          ' Half way below waterπ       Draw.Sprite Turtle2(), XCor5, YCor5π     ELSEIF Under = 2 THEN      ' Almost under waterπ       Draw.Sprite Turtle3(), XCor5, YCor5π     ELSEIF Under = 3 THEN      ' Submerged under waterπ       LINE (1, YCor5 - 4)-(269, YCor5 + 12), 1, BFπ     ELSEIF Under = 0 THEN      ' Completely above waterπ       Draw.Sprite Turtle(), XCor5, YCor5π     END IFπ     XCor = XCor + 30        ' Distance between common spritesπ     XCor2 = XCor2 + 30      ' To chain three sprites at a timeπ     XCor3 = XCor3 + 90π     XCor4 = XCor4 + 30π     XCor5 = XCor5 + 15π   NEXT Xπ   XCor = XCor + 25          ' Extra distance between the spritesπ   XCor2 = XCor2 + 25        ' This allows room for your frog to passπ   XCor4 = XCor4 + 25π   XCor5 = XCor5 + 35πNEXT YπIF FrogY = YCor5 THEN              ' Frogger is on the river.π  C = POINT(FrogX + 5, FrogY + 5)  ' Check if frog is on a turtleπ  IF C = 1 THEN Hit = True         ' or not.π  IF FrogX <= -1 THEN Hit = True   ' Or if the frog sits too longπEND IFπDraw.Sprite Frog(), FrogX, FrogY   ' Update frog positionπLINE (0, 0)-(270, 199), 14, B      ' Redraw the borderπLINE (271, 12)-(319, 199), 0, BF   ' Hide tailing spritesπLOCATE 4, 36: COLOR 15: PRINT ClockπIF Clock = 0 THEN Hit = TrueπPCOPY 1, 0                         ' Display to finished screenππEND SUBπKurt Kuzba                     AVOID BLUE MEANIES             FidoNet QUIK_BAS Echo          04-28-96 (00:00)       QB, QBasic, PDS        142  5773     ARG.BAS     '_|_|_|   A game based on an original game posted on FIDO.π'_|_|_|   From: Andrew Jones     ...   Echo: FidoQBasicπ'_|_|_|   Date: 04-14-96 14:33   ...   Subj: arg.basπ'_|_|_|   No warrantees or guarantees are given or implied.π'_|_|_|   Released to   PUBLIC DOMAIN   by Kurt Kuzba.  (4/28/96)πDECLARE FUNCTION bounc% ()πTYPE dotdata: ox AS INTEGER: xd AS INTEGER: x AS INTEGERπ   oy AS INTEGER: yd AS INTEGER: y AS INTEGER: END TYPEπDIM dot(21) AS dotdata, me(15) AS INTEGER, they(15) AS INTEGERπRANDOMIZE (TIMER * 1000): SCREEN 13πCIRCLE (160, 100), 2, 33: PAINT (160, 100), 33πGET (158, 98)-(162, 102), theyπCIRCLE (160, 100), 2, 65: PAINT (160, 100), 65πGET (158, 98)-(162, 102), meπdot(0).x = 158: dot(0).y = 98: dot(0).xd = 0: dot(0).yd = 0πlevel% = 1000πDOπ   CLS : b$ = STRING$(6, CHR$(177)): S$ = SPACE$(34)π   LOCATE 6, 1: P$ = STRING$(43, CHR$(177)) + S$ + b$π   P$ = P$ + " Avoid all the Blue Meanies while " + b$ + S$ + b$π   P$ = P$ + " the red line crosses the screen! " + b$ + S$ + b$π   P$ = P$ + "   Use the Cursor keys to move.   " + b$ + S$ + b$π   P$ = P$ + "  The ESCAPE key quits the game.  " + b$ + S$ + b$π   P$ = P$ + "    The P key pauses the game.    " + b$ + S$ + b$π   P$ = P$ + "   Possible scores are 0 - 100.   " + b$ + S$ + b$π   P$ = P$ + "   Press any key to begin game.   " + b$ + S$ + b$π   P$ = P$ + STRING$(37, CHR$(177))π   WHILE INKEY$ <> "": WEND: c% = 64π   WHILE INKEY$ = ""π      LOCATE 4, 1: COLOR c%: PRINT P$π      c% = (c% + 1) MOD 103: IF c% = 0 THEN c% = 64π   WENDπ   CLSπ   FOR t% = 1 TO 20π      DO: P% = RND * 300 + 14: LOOP WHILE (P% > 100) AND (P% < 214)π      dot(t%).x = P%: dot(t%).xd = bounc%π      DO: P% = RND * 180 + 14: LOOP WHILE (P% > 70) AND (P% < 144)π      dot(t%).yd = bounc%: dot(t%).y = P%π      PUT (dot(t%).x, dot(t%).y), they, XORπ   NEXTπ   dot(0).x = 155: dot(0).y = 95: PUT (dot(0).x, dot(0).y), me, XORπ   Quit% = 0: Resets& = 1: Score& = 0: Total& = 0π   DO: K$ = "": K$ = UCASE$(INKEY$)π      IF K$ = CHR$(27) THEN Total& = Total& + Score&: EXIT DOπ      IF K$ = "P" THENπ         WHILE INKEY$ <> "": WEND: WHILE INKEY$ = "": WENDπ      END IFπ      WHILE (INP(&H3DA) AND 8) = 0: WENDπ      WHILE (INP(&H3DA) AND 8) <> 0: WENDπ      FOR egg% = 1 TO 10 + (Score& \ 300)π         IF ABS(dot(egg%).x - dot(0).x) < 3 THENπ            IF ABS(dot(egg%).y - dot(0).y) < 3 THENπ               Resets& = Resets& + 1π               Total& = Total& + Score&π               Score& = 0: SOUND 80, 3π               FOR t% = 196 TO 199π                  LINE (0, t%)-(319, t%), 0π               NEXTπ               SOUND 65, 5π            END IFπ         END IFπ         dot(egg%).ox = dot(egg%).x: dot(egg%).oy = dot(egg%).yπ         dot(egg%).x = dot(egg%).x + dot(egg%).xdπ         dot(egg%).y = dot(egg%).y + dot(egg%).ydπ         IF dot(egg%).x < 0 THENπ            dot(egg%).x = 0: dot(egg%).xd = ABS(bounc%)π            SOUND 999, .03π         END IFπ         IF dot(egg%).x > 314 THENπ            dot(egg%).x = 314: dot(egg%).xd = -(ABS(bounc%))π            SOUND 999, .03π         END IFπ         IF dot(egg%).y < 0 THENπ            dot(egg%).y = 0: dot(egg%).yd = ABS(bounc%)π            SOUND 999, .03π         END IFπ         IF dot(egg%).y > 190 THENπ            dot(egg%).y = 190: dot(egg%).yd = -(ABS(bounc%))π            SOUND 999, .03π         END IFπ         PUT (dot(egg%).ox, dot(egg%).oy), they, XORπ         PUT (dot(egg%).x, dot(egg%).y), they, XORπ      NEXTπ      x% = 0: y% = 0π      SELECT CASE INP(&H60)π         CASE 72: IF dot(0).y > 15 THEN y% = -2π         CASE 75: IF dot(0).x > 15 THEN x% = -2π         CASE 77: IF dot(0).x < 300 THEN x% = 2π         CASE 80: IF dot(0).y < 175 THEN y% = 2π      END SELECTπ      K$ = "": K$ = UCASE$(INKEY$)π      IF K$ = CHR$(27) THEN Total& = Total& + Score&: EXIT DOπ      IF K$ = "P" THENπ         WHILE INKEY$ <> "": WEND: WHILE INKEY$ = "": WENDπ      END IFπ      WHILE (INP(&H3DA) AND 8) = 0: WENDπ      WHILE (INP(&H3DA) AND 8) <> 0: WENDπ      IF (x% <> 0) OR (y% <> 0) THENπ         PUT (dot(0).x, dot(0).y), me, XORπ         dot(0).x = dot(0).x + x%: dot(0).y = dot(0).y + y%π         PUT (dot(0).x, dot(0).y), me, XORπ      END IFπ      IF Score& MOD 30 = 0 THENπ         LINE (Score& \ 10, 196)-(Score& \ 10, 199), 4π      END IFπ      Score& = Score& + 1π      IF Score& > 3199 THEN Total& = Total& + Score&: EXIT DOπ   LOOPπ   IF Score& > 3199 THENπ      SOUND 500, 2: COLOR RND * 20 + 50: SOUND 700, 5: LOCATE 11, 16π      SOUND 600, 2: PRINT "YOU WON !!": SOUND 800, 7π      WHILE INKEY$ <> "": WENDπ      DOπ         COLOR RND * 20 + 50: LOCATE 11, 16: PRINT "YOU WON !!"π      LOOP WHILE INKEY$ = ""π      level% = level% * .8π   ELSE level% = 1000π   END IFπ   bl$ = CHR$(221): br$ = CHR$(222): COLOR RND * 50 + 40π   LOCATE 7, 15: PRINT CHR$(220); STRING$(10, CHR$(223)); CHR$(220)π   LOCATE 8, 15: PRINT bl$; "GAME OVER "; br$π   P$ = LEFT$(STR$(FIX((Total& \ Resets&) \ 32)) + "   ", 4)π   LOCATE 9, 15: PRINT bl$; "SCORE:"; P$; br$π   LOCATE 10, 15: PRINT bl$; "PLAY AGAIN"; br$π   LOCATE 11, 15: PRINT bl$; "  (Y/N)?  "; br$π   LOCATE 12, 15: PRINT CHR$(223); STRING$(10, CHR$(220)); CHR$(223)π   Que$ = ". YN" + CHR$(13)π   DOπ      Query$ = UCASE$(INKEY$): DEF SEG = &HA000π      L& = (RND * 100 + 110) + (320 * FIX(RND * 48 + 48))π      IF PEEK(L&) <> 0 THEN POKE L&, RND * 20 + 75π   LOOP WHILE INSTR(Que$, Query$) < 2π   IF INSTR(Que$, Query$) > 3 THEN Quit% = -1πLOOP WHILE NOT Quit%πSCREEN 0: WIDTH 80, 25ππFUNCTION bounc%π   SHARED Score&, level%π   b% = (RND MOD (2 + (Score& \ level%))) + 1π   IF (INP(64) AND 1) = 0 THEN b% = -b%π   bounc% = b%πEND FUNCTIONπSteven Hanov                   PACMAN LIVES!                  [e-mail]             07-18-96 (23:20)       QB, QBasic, PDS        753  21383    PACMAN.BAS  '**************************************************************************π'**                         PACMAN LIVES!                                **π'****           By Steven Hanov ([e-mail])                     **π'**************************************************************************π'** July 1996                                                            **π'** Well, here's MY attempt at Pacman for QBASIC. I derived this game    **π'** from the Commodore 64 version, which was probably based on the Atari **π'** version. Quite a long history! I think it even had a cartoon show... **π'** On a 386, like mine :-(, a speed factor of zero should be used. The  **π'** graphics routines are slower than I'd have liked, but that's life.   **π'** If anyone manages to speed it up greatly, I'd appreciate a copy.     **π'** Just e-mail it to me.                                                **π'**************************************************************************ππDECLARE SUB pacprint (y!, text$)πDECLARE SUB KillPac ()πDECLARE SUB DisplayLives (lives!)πDECLARE SUB UpdateScore ()πDECLARE SUB RedGhost ()πDECLARE SUB GreenGhost ()πDECLARE SUB BlueGhost ()πDECLARE SUB CreateGhost (colour!, frame!)πDECLARE SUB DrawPac (xx!, yy!, dr!)πDIM SHARED pf(-1 TO 81, 25) AS STRING, PacGraph(628)πDIM SHARED BGhost1(628), rGhost1(628), gGhost1(628), ZGhost1(628)πDIM SHARED BGhost2(628), rGhost2(628), GGhost2(628), ZGhost2(628)πDIM SHARED death, PowerUp, PTimer, xx, yy, Score, DontCallGhostsπDIM SHARED GameSpeedπ'*********************************************************************π'** VARIABLE Dictionary **********************************************π'pf(x,y) contains the playing field, * for walls, . for dashes, o for powerupπ'PacGraph, and the Ghosts store the "sprites" of pacman circle and ghostsπ'death - Set by ghost sub to notify main that Pacman has been killedπ'PowerUp - 1 if currently Powered Up, zero otherwiseπ'PTimer - The timer at the time Pacman got powerup.π'xx,yy - usually The current 320x200 screen positionπ'x,y - usually the current 40x25 screen positionπ'DontCallGhosts - Flag used to make DrawPac not call Ghostsπ'GameSpeed - Slow down factorππrt$ = CHR$(0) + "M"     'define right, left, up, down keysπlt$ = CHR$(0) + "K"πup$ = CHR$(0) + "H"πdn$ = CHR$(0) + "P"πSCREEN 12πCIRCLE (150, 200), 150, 14πPAINT (150, 200), 14πLINE (150, 200)-(300, 160), 15πLINE -(300, 240), 15πLINE -(150, 200)πPAINT (160, 200), 0, 15             'The next several lines drawπLINE (150, 200)-(300, 160), 0      'the title screen...πLINE -(300, 240), 0πLINE -(150, 200), 0πCIRCLE (175, 125), 30, 0πPAINT (175, 125), 15, 0πCIRCLE (180, 130), 20, 0πPAINT (180, 130), 0, 0πCIRCLE (500, 150), 100, 4πPAINT (500, 150), 4πLINE (400, 150)-(400, 400), 4πLINE (600, 150)-(600, 400), 4πDRAW "BM600,400 H20 G20 H20 G20 H20 G20 H20 G20 H20 G20"πPAINT (500, 300), 4πCIRCLE (450, 150), 25, 0πCIRCLE (550, 150), 25, 0πPAINT (450, 150), 15, 0πPAINT (550, 150), 15, 0πCIRCLE (440, 150), 12, 0πCIRCLE (540, 150), 12, 0πPAINT (440, 150), 0πPAINT (540, 150), 0πCIRCLE (500, 225), 30, 0, , , .5πPAINT (500, 225), 0, 0πCOLOR 9πx = 25πy = 0πLINE (x, y)-(x + 30, y + 100), 9, BFπCIRCLE (x + 35, y + 31), 30, 9πPAINT (x + 35, y + 31), 9, 9πCIRCLE (x + 35, y + 31), 2, 0πPAINT (x + 35, y + 31), 0, 0πx = x + 60πLINE (x + 40, y)-(x, y + 100)πLINE -(x + 80, y + 100)πLINE -(x + 40, y)πPAINT (x + 40, y + 50), 9, 9πCIRCLE (x + 40, y + 50), 2, 0πPAINT (x + 40, y + 50), 0, 0πx = x + 90πCIRCLE (x + 40, y + 50), 50πPAINT (x + 40, y + 50), 9, 9πLINE (x + 40, y + 50)-(x + 90, y + 20), 0πLINE -(x + 90, y + 80), 0πLINE -(x + 40, y + 50), 0πPAINT (x + 60, y + 50), 0, 0πx = x + 90πLINE (x + 10, y + 40)-(x + 40, y + 60), 9, BFπx = x + 50ππLINE (x, y)-(x, y + 100), 9πLINE -(x + 90, y + 100), 9πLINE -(x + 90, y), 9πLINE -(x + 45, y + 50), 9πLINE -(x, y), 9πPAINT (x + 45, y + 75), 9, 9ππx = x + 100πLINE (x + 40, y)-(x, y + 100)πLINE -(x + 80, y + 100)πLINE -(x + 40, y)πPAINT (x + 40, y + 50), 9, 9πCIRCLE (x + 40, y + 50), 2, 0πPAINT (x + 40, y + 50), 0, 0πx = x + 90πLINE (x, y)-(x, y + 100), 9πLINE -(x + 90, y + 100), 9πLINE -(x + 90, y), 9πLINE -(x + 60, y), 9πLINE -(x + 60, y + 50), 9πLINE -(x, y), 9πPAINT (x + 30, y + 30), 9, 9ππCOLOR 15πLOCATE 8, 36πPRINT "Lives!"πLOCATE 28, 20πCOLOR 9πPRINT "Coded by Steven Hanov ([e-mail])"ππWHILE INKEY$ = "": WENDπSCREEN 7                  'OK, now the real program begins!πRANDOMIZE TIMERπCLSπCIRCLE (12, 12), 5, 14πPAINT (12, 12), 14πGET (7, 7)-(17, 17), PacGraphπCreateGhost 9, 1             'Create and store "sprites"πGET (1, 0)-(11, 9), BGhost1πCreateGhost 9, 2πGET (1, 0)-(11, 9), BGhost2πCreateGhost 4, 1πGET (1, 0)-(11, 9), rGhost1πCreateGhost 4, 2πGET (1, 0)-(11, 9), rGhost2πCreateGhost 2, 1πGET (1, 0)-(11, 9), gGhost1πCreateGhost 2, 2πGET (1, 0)-(11, 9), GGhost2πCreateGhost 1, 1πGET (1, 0)-(11, 9), ZGhost1πCreateGhost 1, 2πGET (1, 0)-(11, 9), ZGhost2πCLSπpacprint 5, "Enter a delay factor, to"πpacprint 6, "slow down the game for"πpacprint 7, "fast computers. (0-15)"πLOCATE 9, 18: INPUT ">", a$πGameSpeed = VAL(a$) * 100πStart:πCLSπRESTOREπlives = 3πy = 0πxx = 0πyy = 0πDOπ   READ a$                         'Read in, store, and displayπ   IF a$ = "STOP" THEN EXIT DO     'the playing field. (Stored in pf())π   yy = yy + 1π   FOR xx = 1 TO LEN(a$)π      y = yy * 8 - 8π      x = xx * 8 - 8π      B$ = MID$(a$, xx, 1)π      IF B$ = "." THENπ         LOCATE yy, xx + 1π         LINE (x + 3, y + 4)-(x + 5, y + 5), 14, Bπ         pf(xx, yy) = B$π         dots = dots + 1π      ELSEIF B$ = "o" THENπ         LOCATE yy, xx + 1π         CIRCLE (x + 4, y + 4), 3, 14π         PAINT (x + 4, y + 4), 14, 14π         pf(xx, yy) = B$π      ELSEIF B$ = " " THENπ         PRINT " ";π         pf(xx, yy) = " "π      ELSEπ         COLOR 1             'For simplicity, all wall blocks areπ         PRINT B$;           'stored in pf() array as "*"'sπ         pf(xx, yy) = "*"π      END IFπ   NEXTπ   PRINTπLOOPπDOπ     x = 20π     y = 18π     xx = x * 8 - 8π     yy = y * 8 - 8π     dr = 4π     DisplayLives livesπ     PCOPY 0, 1π     DrawPac xx + 1, yy, 4π     DrawPac xx, yy, 4π     a$ = ""π     DO                             'This big DO-LOOP is the heart of theπ     IF LEN(c$) = 0 THEN            'program, detecting keys and movingπ          B$ = INKEY$               'pacman.π     ELSEπ          B$ = c$π          c$ = ""π     END IFπ     DrawPac xx, yy, drπ     IF LEN(B$) > 0 THENπ          IF B$ = CHR$(27) THEN CLS : GOTO Quitπ          free = 0π          π          IF B$ = up$ AND pf(x, y - 1) <> "*" THEN free = free + 1π          IF B$ = rt$ AND pf(x + 1, y) <> "*" THEN free = free + 1π          IF B$ = dn$ AND pf(x, y + 1) <> "*" THEN free = free + 1π          IF B$ = lt$ AND pf(x - 1, y) <> "*" THEN free = free + 1π          IF free > 0 THENπ          a$ = B$π          c$ = ""π          END IFπ     END IFπ     IF a$ = rt$ AND pf(x + 1, y) <> "*" THENπ          dr = 2π          FOR s = 1 TO 8π               xx = xx + 1π               DrawPac xx, yy, drπ          NEXTπ          x = x + 1π          IF x = 39 THEN x = 1: xx = 1: DrawPac xx, yy, drπ     ELSEIF a$ = lt$ AND pf(x - 1, y) <> "*" THENπ          dr = 4π          FOR s = 1 TO 8π               xx = xx - 1π               DrawPac xx, yy, drπ               IF xx = 1 THEN x = 40: xx = 39 * 8 - 8π          NEXTπ          x = x - 1π     ELSEIF a$ = up$ AND pf(x, y - 1) <> "*" THENπ          dr = 1π          FOR s = 1 TO 8π               yy = yy - 1π               DrawPac xx, yy, drπ          NEXTπ          y = y - 1π     ELSEIF a$ = dn$ AND pf(x, y + 1) <> "*" THENπ          dr = 3π          FOR s = 1 TO 8π               yy = yy + 1π               DrawPac xx, yy, drπ          NEXTπ          y = y + 1π     END IFπ     IF pf(x, y) = "." THENπ          Score = Score + 10π          pf(x, y) = " "π          dots = dots - 1π          SOUND 800, .25π          SOUND 900, .25π          UpdateScoreπ          IF dots = 0 THEN EXIT DOπ     ELSEIF pf(x, y) = "o" THENπ          PowerUp = 1π          pf(x, y) = " "π          Score = Score + 100π          UpdateScoreπ          FOR s = 37 TO 4000 STEP 20π               SOUND s, .05π               SOUND s + 100, .05π               SOUND s + 200, .05π               SOUND s + 300, .05π          NEXTπ          PTimer = TIMERπ     END IFπ     IF xx MOD 8 = 1 THEN xx = xx - 1π     IF death = 1 THEN KillPac: EXIT DOπ     LOOPπ     IF dots = 0 THEN EXIT DOπ     lives = lives - 1π     DisplayLives livesπ     death = 0πLOOP UNTIL lives = -1πCLSπCOLOR 4πIF lives = -1 THENπ   pacprint 10, "You LOSE!"πELSEπ   pacprint 10, "You WIN!"πEND IFπSLEEP 1ππQuit:πCOLOR 15πpacprint 15, "Final Score:" + STR$(Score)πCOLOR 9πpacprint 20, "ENTER to play again, or ESC to exit"πDOπ   a$ = INKEY$πLOOP UNTIL a$ = CHR$(27) OR a$ = CHR$(13)πIF a$ = CHR$(27) THEN SCREEN 0: COLOR 7: ENDπIF a$ = CHR$(13) THEN GOTO Startπππππππ'     1234567890123456789012345678901234567890πDATA "╔══════════════════╦══════════════════╗"πDATA "║..................║..................║"πDATA "║.┌────┐.┌───────┐.║.┌───────┐.┌────┐.║"πDATA "║.│    │.│       │.║.│       │.│    │.║"πDATA "║o└────┘.└───────┘.║.└───────┘.└────┘o║"πDATA "║.....................................║"πDATA "║.══════.┌─┐.══════╦══════.┌─┐.══════.║"πDATA "║........│ │.......║.......│ │........║"πDATA "╚══════╗.│ ╞══════ ║ ══════╡ │.╔══════╝"πDATA "       ║.│ │               │ │.║       "πDATA "═══════╝.└─┘ ┌───── ─────┐ └─┘.╚═══════"πDATA " ..........  │           │  .......... "πDATA "═══════╗.┌─┐ └───────────┘ ┌─┐.╔═══════"πDATA "       ║.│ │               │ │.║       "πDATA "╔══════╝.└─┘ ══════╦══════ └─┘.╚══════╗"πDATA "║..................║..................║"πDATA "║.═════╗.═════════.║.═════════.╔═════.║"πDATA "║o.....║.......................║.....o║"πDATA "╠═════.║.┌─┐.══════╦══════.┌─┐.║.═════╣"πDATA "║........│ │.......║.......│ │........║"πDATA "║.═══════╧═╧══════.║.══════╧═╧═══════.║"πDATA "║.....................................║"πDATA "╚═════════════════════════════════════╝"πππDATA STOPππ'Takes care of blue ghost.π'And I mean it takes care of EVERYTHING:π'Drawing, artificial intelligence, killing Pacman, Killing itself...etc.π'πSUB BlueGhostππ'VARIABLES:π'px,py - current pixel positionπ'PrevX,PrevY - previous pixel position (for erasing)π'flag - First time called?π'xdir, ydir - Which direction am I going in? (incremental values)ππSTATIC frame, PrevX, PrevY, flag, px, py, xdir, ydirπIF flag = 0 THENπ   flag = 1            'If first time called,π   PrevX = 17 * 8 - 8  'Set ghost to default positionπ   PrevY = 12 * 8 - 8π   px = PrevXπ   py = PrevYπ   xdir = 1    'Start off going rightπ   ydir = 0πEND IFπIF PowerUp = 1 THENπ   speed = .5       'Powerup means half speed of ghostsπELSEπ   speed = 1πEND IFππLINE (PrevX, PrevY)-(PrevX + 10, PrevY + 9), 0, BF 'ERase previous drawππIF px MOD 8 = 0 AND py MOD 8 = 0 THEN  'If you're centered on 8x8 box,π   x = (px \ 8) + 1      'Calculate real 40x25 screen positionπ   y = (py \ 8) + 1π   IF pf(x - xdir, y - ydir) = "." THEN     'Redraw the pellet you passedπ         xp = CINT(px) - 8 * xdir           'overπ         yp = CINT(py) - 8 * ydirπ         LINE (xp + 3, yp + 4)-(xp + 5, yp + 5), 14, Bπ   ELSEIF pf(x - xdir, y - ydir) = "o" THEN   'redraw the powerup you passedπ         xp = CINT(px) - 8 * xdir             'overπ         yp = CINT(py) - 8 * ydirπ         CIRCLE (xp + 4, yp + 4), 3, 14π         PAINT (xp + 4, yp + 4), 14, 14π   END IFπ   IF pf(x, y + 1) <> "*" THEN free = free + 1   'Count the number of choicesπ   IF pf(x + 1, y) <> "*" THEN free = free + 1   'of directions without wallsπ   IF pf(x, y - 1) <> "*" THEN free = free + 1π   IF pf(x - 1, y) <> "*" THEN free = free + 1π   IF free > 2 OR pf(x + xdir, y + ydir) = "*" THEN 'IF you HAVE a choice,π      DOπ         IF RND > .5 THENπ            xdir = 1π            ydir = 0         'Keep picking a random direction untilπ         ELSE                'you find one without a wall.π            ydir = 1π            xdir = 0π         END IFπ         IF RND > .5 THEN xdir = -xdir: ydir = -ydirπ         IF pf(x + xdir, y + ydir) <> "*" THEN EXIT DOπ      LOOPπ   END IFπEND IFπpx = px + xdir * speed          'Move the px,py co-ordinateπpy = py + ydir * speedπIF px > 309 THEN px = 1      'Scroll from one side of screen to otherπIF CINT(px) = 0 THEN px = 304πframe = frame + 1: IF frame = 2 THEN frame = 0 'Ghosts have two frames forπIF frame = 0 THEN                              'animationπ   IF PowerUp = 1 THENπ      PUT (px, py), ZGhost1         'You have powerup, show scared ghostπ   ELSEπ      PUT (px, py), BGhost1       'Show regular ghostπ   END IFπELSEπ   IF PowerUp = 1 THEN       'OR frame 2 of same.π      PUT (px, py), ZGhost2π   ELSEπ      PUT (px, py), BGhost2π   END IFπEND IFπPrevX = CINT(px)πPrevY = CINT(py)ππ   gx = (px \ 8) + 1π   gy = (py \ 8) + 1π   IF gx = xx \ 8 + 1 AND gy = yy \ 8 + 1 THEN  'If you hit Pacman,π      IF PowerUp = 1 THENπ         Score = Score + 200              'And he has powerup, kill ghostπ         UpdateScoreπ         FOR s = 37 TO 5000 STEP 500π            SOUND s, 1π         NEXTπ         flag = 0π      ELSEπ         death = 1                     'OR else kill Pacman.π      END IFπ   END IFπππEND SUBππSUB CreateGhost (colour, frame)πCLSπCIRCLE (6, 3), 5, colour, 0, 6.28, .5πLINE (1, 3)-(11, 8), colour, BFπPAINT (6, 2), colour, colourπCIRCLE (3, 3), 1, 15πCIRCLE (9, 3), 1, 15πPSET (3, 3), 15πPSET (9, 3), 15πSELECT CASE frameπ     CASE 1π          DRAW "BM1,9 C" + STR$(colour) + " e1f1e1f1e1F1e1f1e1f1"π          PSET (4, 3), 0π          PSET (10, 3), 0π     CASE 2π          DRAW "BM1,8 C" + STR$(colour) + " f1e1f1e1f1e1f1e1f1e1"π          PSET (2, 3), 0π          PSET (8, 3), 0πEND SELECTπIF colour = 1 THENπ   DRAW "BM2,7 C0 e1r1f1r1e1r1f1r1"πEND IFπEND SUBππSUB DisplayLives (lives)ππx = 308πy = 187πLINE (x + 5, y - 5)-(x - 100, y + 5), 0, BFπFOR s = 1 TO livesπ   GOSUB TinyPacπ   x = x - 16πNEXTπEXIT SUBππTinyPac:πCIRCLE (x - 1, y), 4, 14πPAINT (x - 1, y), 14, 14πLINE (x, y)-(x - 5, y - 2), 0πLINE (x, y)-(x - 5, y + 2), 0πLINE -(x - 5, y - 2), 0πPAINT (x - 3, y), 0, 0πRETURNππEND SUBππSUB DrawPac (xx, yy, dr)πSTATIC a, PrevX, PrevY, flag, adirπFOR s = 1 TO GameSpeed: NEXTπIF flag = 0 THEN  'If first time called, set PrevX,Y to same as xx,yyπ   adir = 1π   flag = 1π   PrevX = xxπ   PrevY = yyπEND IFπIF xx = 0 THEN xx = 1       'Solves mysterious problem.πIF PrevX <> xx OR PrevY <> yy THEN  'Don't redraw if standing still.π   a = a + adir                        '"a" value moves mouthπ   IF a = 5 OR a = 0 THEN adir = -adirπ   LINE (PrevX - 1, PrevY)-(PrevX + 10, PrevY + 8), 0, BFπ   PUT (xx - 1, yy - 1), PacGraphπ   SELECT CASE dr                   'dr is direction:1=up, clockwise.π   CASE 1π      LINE (xx + 4, yy + 5)-(xx + 4 - a, yy), 0π      LINE (xx + 4, yy + 5)-(xx + 4 + a, yy), 0π      LINE -(xx + 4 - a, yy), 0π      PAINT (xx + 4, yy + 1), 0, 0π  CASE 2π   LINE (xx + 3, yy + 4)-(xx + 9, yy + 4 - a), 0π   LINE (xx + 3, yy + 4)-(xx + 9, yy + 4 + a), 0π   LINE -(xx + 9, yy + 4 - a), 0π   PAINT (xx + 7, yy + 4), 0, 0π  CASE 3π   LINE (xx + 4, yy + 3)-(xx + 4 - a, yy + 8), 0π   LINE (xx + 4, yy + 3)-(xx + 4 + a, yy + 8), 0π   LINE -(xx + 4 - a, yy + 8), 0π   PAINT (xx + 4, yy + 7), 0, 0π  CASE 4π   LINE (xx + 5, yy + 4)-(xx - 1, yy + 4 - a), 0π   LINE (xx + 5, yy + 4)-(xx - 1, yy + 4 + a), 0π   LINE -(xx - 1, yy + 4 - a), 0π   PAINT (xx, yy + 4), 0, 0π  END SELECTπEND IFπPrevX = xxπPrevY = yyππIF TIMER - PTimer > 10 THEN PowerUp = 0  'Powerup lasts 10 secondsπIF DontCallGhosts = 0 THENπ   RedGhostπ   GreenGhost     'Move the three ghostsπ   BlueGhostπEND IFπEND SUBππ'For comments, see BlueGhost subπSUB GreenGhostπSTATIC frame, PrevX, PrevY, flag, px, py, xdir, ydirπIF flag = 0 THENπ   flag = 1π   PrevX = 17 * 8 - 8π   PrevY = 12 * 8 - 8π   px = PrevXπ   py = PrevYπ   xdir = 1π   ydir = 0πEND IFπIF PowerUp = 1 THENπ   speed = .5πELSEπ   speed = 1πEND IFππLINE (PrevX, PrevY)-(PrevX + 10, PrevY + 9), 0, BFππIF px MOD 8 = 0 AND py MOD 8 = 0 THENπ   x = (px \ 8) + 1π   y = (py \ 8) + 1π   IF pf(x - xdir, y - ydir) = "." THENπ         xp = CINT(px) - 8 * xdirπ         yp = CINT(py) - 8 * ydirπ         LINE (xp + 3, yp + 4)-(xp + 5, yp + 5), 14, Bπ   ELSEIF pf(x - xdir, y - ydir) = "o" THENπ         xp = CINT(px) - 8 * xdirπ         yp = CINT(py) - 8 * ydirπ         CIRCLE (xp + 4, yp + 4), 3, 14π         PAINT (xp + 4, yp + 4), 14, 14π   END IFπ   IF pf(x, y + 1) <> "*" THEN free = free + 1π   IF pf(x + 1, y) <> "*" THEN free = free + 1π   IF pf(x, y - 1) <> "*" THEN free = free + 1π   IF pf(x - 1, y) <> "*" THEN free = free + 1π   IF free > 2 OR pf(x + xdir, y + ydir) = "*" THENπ      DOπ         IF RND > .5 THENπ            xdir = 1π            ydir = 0π         ELSEπ            ydir = 1π            xdir = 0π         END IFπ         IF RND > .5 THEN xdir = -xdir: ydir = -ydirπ         IF pf(x + xdir, y + ydir) <> "*" THEN EXIT DOπ      LOOPπ   END IFπEND IFπpx = px + xdir * speedπpy = py + ydir * speedπIF px > 309 THEN px = 1πIF CINT(px) = 0 THEN px = 304πframe = frame + 1: IF frame = 2 THEN frame = 0πIF frame = 0 THENπ   IF PowerUp = 1 THENπ      PUT (px, py), ZGhost1π   ELSEπ      PUT (px, py), gGhost1π   END IFπELSEπ   IF PowerUp = 1 THENπ      PUT (px, py), ZGhost2π   ELSEπ      PUT (px, py), GGhost2π   END IFπEND IFπPrevX = CINT(px)πPrevY = CINT(py)ππ   gx = (px \ 8) + 1π   gy = (py \ 8) + 1π   IF gx = xx \ 8 + 1 AND gy = yy \ 8 + 1 THENπ      IF PowerUp = 1 THENπ         Score = Score + 200π         UpdateScoreπ         FOR s = 37 TO 5000 STEP 500π            SOUND s, 1π         NEXTπ         flag = 0π      ELSEπ         death = 1π      END IFπ   END IFπEND SUBππ'Makes Pacman eat himself.π'πSUB KillPacπLINE (xx - 1, yy)-(xx + 10, yy + 8), 0, BF 'Blank out backgroundπPUT (xx - 1, yy - 1), PacGraph      'Put the PacCircle thereπfreq = 1500 'Sound valuesπfreq2 = 500πFOR y = -5 TO 5 STEP .2π      LINE (xx + 4, yy + 5)-(xx + 4 + SQR(25 - y ^ 2), yy + 5 + y), 0π      LINE (xx + 4, yy + 5)-(xx + 4 - SQR(25 - y ^ 2), yy + 5 + y), 0π               '^ Wow! I actually found a use for grade 12 math!π      SOUND freq, .5π      SOUND freq2, .5π      freq = freq - 10π      freq2 = freq2 + 10πNEXTπEND SUBππSUB pacprint (y, text$)πDontCallGhosts = 1πyy = y * 8 - 8πx = 20 - LEN(text$) \ 2πxx = x * 8 - 7πFOR letter = 1 TO LEN(text$)π   FOR xx = xx TO xx + 7π      DrawPac xx, yy, 2π   NEXTπ   LOCATE y, xπ   x = x + 1π   PRINT MID$(text$, letter, 1)π   SOUND 800, .25π   SOUND 900, .25πNEXTπDontCallGhosts = 0πEND SUBππ'For comments, see BlueGhost subπSUB RedGhostπSTATIC frame, PrevX, PrevY, flag, px, py, xdir, ydirπIF flag = 0 THENπ   flag = 1π   PrevX = 17 * 8 - 8π   PrevY = 12 * 8 - 8π   px = PrevXπ   py = PrevYπ   xdir = 1π   ydir = 0πEND IFπIF PowerUp = 1 THENπ   speed = .5πELSEπ   speed = 1πEND IFππLINE (PrevX, PrevY)-(PrevX + 10, PrevY + 9), 0, BFππIF px MOD 8 = 0 AND py MOD 8 = 0 THENπ   x = (px \ 8) + 1π   y = (py \ 8) + 1π   IF pf(x - xdir, y - ydir) = "." THENπ         xp = CINT(px) - 8 * xdirπ         yp = CINT(py) - 8 * ydirπ         LINE (xp + 3, yp + 4)-(xp + 5, yp + 5), 14, Bπ   ELSEIF pf(x - xdir, y - ydir) = "o" THENπ         xp = CINT(px) - 8 * xdirπ         yp = CINT(py) - 8 * ydirπ         CIRCLE (xp + 4, yp + 4), 3, 14π         PAINT (xp + 4, yp + 4), 14, 14π   END IFπ   IF pf(x, y + 1) <> "*" THEN free = free + 1π   IF pf(x + 1, y) <> "*" THEN free = free + 1π   IF pf(x, y - 1) <> "*" THEN free = free + 1π   IF pf(x - 1, y) <> "*" THEN free = free + 1π   IF free > 2 OR pf(x + xdir, y + ydir) = "*" THENπ      DOπ         IF RND > .5 THENπ            xdir = 1π            ydir = 0π         ELSEπ            ydir = 1π            xdir = 0π         END IFπ         IF RND > .5 THEN xdir = -xdir: ydir = -ydirπ         IF pf(x + xdir, y + ydir) <> "*" THEN EXIT DOπ      LOOPπ   END IFπEND IFπpx = px + xdir * speedπpy = py + ydir * speedπIF px > 309 THEN px = 1πIF CINT(px) = 0 THEN px = 304πframe = frame + 1: IF frame = 2 THEN frame = 0πIF frame = 1 THENπ   IF PowerUp = 1 THENπ      PUT (px, py), ZGhost1π   ELSEπ      PUT (px, py), rGhost1π   END IFπELSEπ   IF PowerUp = 1 THENπ      PUT (px, py), ZGhost2π   ELSEπ      PUT (px, py), rGhost2π   END IFπEND IFπPrevX = CINT(px)πPrevY = CINT(py)ππ   gx = (px \ 8) + 1π   gy = (py \ 8) + 1π   IF gx = xx \ 8 + 1 AND gy = yy \ 8 + 1 THENπ      IF PowerUp = 1 THENπ         Score = Score + 200π         UpdateScoreπ         FOR s = 37 TO 5000 STEP 500π            SOUND s, 1π         NEXTπ         flag = 0π      ELSEπ         death = 1π      END IFπ   END IFπEND SUBππSUB UpdateScoreπLOCATE 24, 1πCOLOR 15πPRINT Score;πEND SUBππRobert Anthony Moreno          SUPER GALATIC WARS             alt.lang.basic                 07-27-96 (00:00)       QB, QBasic, PDS        402  10961    GALATIC.BAS 'Robert Anthony Moreno IIπ'[e-mail]πRANDOMIZE TIMERπDEFINT A-ZπDIM baddirection(10)πDIM badshoot(10)πDIM badshooting(10)πDIM badshotx(10)πDIM badshoty(10)πDIM badx(10)πDIM bady(10)πDIM dead(10)πDIM shooting(10)πDIM shotx(10)πDIM shoty(10)πDIM starc(100)πDIM stars(100)πDIM stari(100)πDIM starx(100)πDIM stary(100)πCLSπLOCATE 11, 26, 0πCOLOR 11, 0πPRINT "Moreno Computer Development!"πLOCATE 13, 26, 0πCOLOR 12, 0πPRINT "   P r e s e n t s . . .    "πSLEEP 3πstart:πdelay = VAL(COMMAND$)πIF delay = 0 THEN delay = 1000πSCREEN 13πCLSπPALETTE 31, 0πPALETTE 32, 0πLOCATE 11, 12, 0πCOLOR 31πPRINT "Super"πLOCATE 12, 15, 0πCOLOR 32πPRINT "Galactic Wars"πFOR c = 0 TO 63π PALETTE 32, cπNEXT cπFOR c = 0 TO 63π PALETTE 31, cπNEXT cπPLAY "MBL25CDEFGAB"πSLEEP 1πPALETTE 1, (63 * 1) + (63 * 256) + (63 * 65536)πPALETTE 2, (55 * 1) + (55 * 256) + (55 * 65536)πPALETTE 3, (45 * 1) + (45 * 256) + (45 * 65536)πPALETTE 4, (40 * 1) + (40 * 256) + (40 * 65536)πPALETTE 8, (50 * 1) + (25 * 256) + (25 * 65536)πPALETTE 9, (25 * 1) + (25 * 256) + (25 * 65536)πPALETTE 10, (40 * 1) + (40 * 256) + (40 * 65536)πPALETTE 11, (20 * 1) + (20 * 256) + (63 * 65536)πPALETTE 12, (63 * 1) + (0 * 256) + (0 * 65536)πPALETTE 20, 0πPALETTE 21, 20πPALETTE 22, 30πPALETTE 23, 40πPALETTE 24, 50πPALETTE 25, 60πFOR i = 100 TO 110π PALETTE i, 0πNEXT iπCOLOR 11πDOπ IF t = 0 THENπ  d = 0π  c = 0π END IFπ IF t = 100 THENπ  d = 1π  c = 11π END IFπ IF d = 0 THEN t = t + 1π IF d = 1 THEN t = t - 1π COLOR cπ LOCATE 15, 10, 0π PRINT "Press Enter To Start"πLOOP UNTIL INKEY$ = CHR$(13)πDO: LOOP UNTIL INKEY$ = ""πCLSπFOR i = 0 TO 100π starx(i) = (RND * 320)π stary(i) = (RND * 179) + 10π stars(i) = (RND * 3) + 2π starc(i) = (RND * 3) + 1πNEXT iπFOR i = 1 TO 10π badx(i) = (RND * 195) + 100π bady(i) = (RND * 150) + 25π baddirection(i) = (RND * 3) + 1πNEXT iπCOLOR 1πshield = 5πx = 40πy = 100πLINE (0, 9)-(320, 9), 1πLINE (0, 190)-(320, 190), 1πLOCATE 25, 1, 0πPRINT "<Esc> Exit : <P> Pause";πLOCATE 1, 1, 0πPRINT " Shields:"; shield; " Score:"; scoreπDOπ FOR i = 1 TO 100π  PSET (starx(i), stary(i)), 0π  stari(i) = stari(i) + 1π  IF stari(i) = stars(i) THENπ   starx(i) = starx(i) - 1π   stari(i) = 0π  END IFπ  IF starx(i) < 0 THENπ   starx(i) = (RND * 50) + 320π   stary(i) = (RND * 179) + 10π   stars(i) = (RND * 3) + 2π   starc(i) = (RND * 3) + 1π  END IFπ  PSET (starx(i), stary(i)), starc(i)π NEXT iπ key$ = INKEY$π SELECT CASE UCASE$(key$)π  CASE CHR$(27): GOTO quitπ  CASE "P"π   LOCATE 25, 1, 0π   PRINT STRING$(40, CHR$(32));π   LOCATE 25, 1, 0π   PRINT "Game Paused... Press Enter";π   DO: LOOP UNTIL INKEY$ = CHR$(13)π   LOCATE 25, 1, 0π   PRINT STRING$(40, CHR$(32));π   LOCATE 25, 1, 0π   PRINT "<Esc> Exit : <P> Pause";π  CASE CHR$(13): IF shooting = 0 THEN shoot = 1π  CASE CHR$(0) + "H": direction = 1π  CASE CHR$(0) + "P": direction = 2π  CASE CHR$(0) + "K": direction = 3π  CASE CHR$(0) + "M": direction = 4π  CASE CHR$(32): direction = 0π END SELECTπ LINE (x + 7, y - 4)-(x - 4, y - 4), 0π LINE (x + 7, y + 4)-(x - 4, y + 4), 0π LINE (x + 6, y - 3)-(x + 6, y + 3), 0π LINE (x + 7, y - 3)-(x + 7, y + 3), 0π LINE (x + 8, y - 3)-(x + 8, y + 3), 0π LINE (x + 1, y)-(x - 2, y - 3), 0π LINE (x + 1, y)-(x - 2, y + 3), 0π LINE (x - 4, y - 3)-(x + 3, y - 3), 0π LINE (x - 4, y + 3)-(x + 3, y + 3), 0π LINE (x - 1, y)-(x + 5, y), 0π CIRCLE (x, y), 10, 0, , , .6π IF direction = 1 AND y > 25 THEN y = y - 1π IF direction = 2 AND y < 174 THEN y = y + 1π IF direction = 3 AND x > 25 THEN x = x - 1π IF direction = 4 AND x < 295 THEN x = x + 1π IF direction = 1 OR direction = 2 THENπ  IF y = 25 THEN direction = 0π  IF y = 174 THEN direction = 0π END IFπ IF direction = 3 OR direction = 4 THENπ  IF x = 25 THEN direction = 0π  IF x = 295 THEN direction = 0π END IFπ LINE (x + 7, y - 4)-(x - 4, y - 4), 100π LINE (x + 7, y + 4)-(x - 4, y + 4), 100π LINE (x + 6, y - 3)-(x + 6, y + 3), 100π LINE (x + 7, y - 3)-(x + 7, y + 3), 100π LINE (x + 8, y - 3)-(x + 8, y + 3), 100π LINE (x + 1, y)-(x - 2, y - 3), 9π LINE (x + 1, y)-(x - 2, y + 3), 9π LINE (x - 4, y - 3)-(x + 3, y - 3), 11π LINE (x - 4, y + 3)-(x + 3, y + 3), 11π LINE (x - 1, y)-(x + 5, y), 10π CIRCLE (x, y), 10, (shield + 20), , , .6π IF shoot = 1 THENπ  FOR i = 1 TO 10π   IF shooting(i) = 0 THENπ    shooting(i) = 1π    shotx(i) = x + 8π    shoty(i) = yπ    SOUND 100, .05π    EXIT FORπ   END IFπ  NEXT iπ  shoot = 0π END IFπ FOR ii = 1 TO 10π  IF shooting(ii) = 1 THENπ   PSET (shotx(ii), shoty(ii)), 0π   shotx(ii) = shotx(ii) + 2π   IF shotx(ii) > 320 THEN shooting(ii) = 0π   pixel = POINT(shotx(ii), shoty(ii))π   IF pixel > 100 THENπ    die = pixel - 100π    FOR i = 1 TO 10π     CIRCLE (badx(die), bady(die)), i, 12π    NEXT iπ    PLAY "MFL50DC"π    FOR i = 1 TO 10π     CIRCLE (badx(die), bady(die)), i, 0π     SOUND 100, .05π    NEXT iπ    score = score + (badx(die) - x)π    LOCATE 1, 1, 0π    PRINT " Shields:"; shield; " Score:"; scoreπ    i = dieπ    PSET (shotx(ii), shoty(ii)), 0π    LINE (badx(i) - 7, bady(i) + 4)-(badx(i) + 4, bady(i) + 4), 0π    LINE (badx(i) - 7, bady(i) - 4)-(badx(i) + 4, bady(i) - 4), 0π    LINE (badx(i) - 6, bady(i) + 3)-(badx(i) - 6, bady(i) - 3), 0π    LINE (badx(i) - 7, bady(i) + 3)-(badx(i) - 7, bady(i) - 3), 0π    LINE (badx(i) - 8, bady(i) + 3)-(badx(i) - 8, bady(i) - 3), 0π    LINE (badx(i) + 3, bady(i) + 3)-(badx(i) - 3, bady(i) - 3), 0π    LINE (badx(i) + 3, bady(i) - 3)-(badx(i) - 3, bady(i) + 3), 0π    LINE (badx(i) - 5, bady(i))-(badx(i) + 2, bady(i)), 0π    dead(i) = 1π    shotx(ii) = 325π   END IFπ   PSET (shotx(ii), shoty(ii)), 12π  END IFπ NEXT iiπ FOR i = 1 TO 10π  IF dead(i) = 0 THENπ   IF badshooting(i) = 0 AND x < badx(i) THENπ    IF y > bady(i) AND direction = 1 THENπ     IF (y - bady(i)) * 2 <= (badx(i) - x) THEN badshoot(i) = 1π    END IFπ    IF y < bady(i) AND direction = 2 THENπ     IF (bady(i) - y) * 2 <= (badx(i) - x) THEN badshoot(i) = 1π    END IFπ    IF y = bady(i) AND direction = 0 THEN badshoot(i) = 1π   END IFπ   IF badshoot(i) = 1 THENπ    badshooting(i) = 1π    badshotx(i) = badx(i) - 8π    badshoty(i) = bady(i)π    badshoot(i) = 0π    SOUND 100, .05π   END IFπ   LINE (badx(i) - 7, bady(i) + 4)-(badx(i) + 4, bady(i) + 4), 0π   LINE (badx(i) - 7, bady(i) - 4)-(badx(i) + 4, bady(i) - 4), 0π   LINE (badx(i) - 6, bady(i) + 3)-(badx(i) - 6, bady(i) - 3), 0π   LINE (badx(i) - 7, bady(i) + 3)-(badx(i) - 7, bady(i) - 3), 0π   LINE (badx(i) - 8, bady(i) + 3)-(badx(i) - 8, bady(i) - 3), 0π   LINE (badx(i) + 3, bady(i) + 3)-(badx(i) - 3, bady(i) - 3), 0π   LINE (badx(i) + 3, bady(i) - 3)-(badx(i) - 3, bady(i) + 3), 0π   LINE (badx(i) - 5, bady(i))-(badx(i) + 2, bady(i)), 0π   IF baddirection(i) = 1 AND bady(i) > 25 THEN bady(i) = bady(i) - 1π   IF baddirection(i) = 2 AND bady(i) < 174 THEN bady(i) = bady(i) + 1π   IF baddirection(i) = 3 AND badx(i) > 100 THEN badx(i) = badx(i) - 1π   IF baddirection(i) = 4 AND badx(i) < 295 THEN badx(i) = badx(i) + 1π   r = (RND * 4)π   IF baddirection(i) = r THEN baddirection(i) = (RND * 4)π   IF i <= 5 THENπ    IF direction = 0 AND x < badx(i) THENπ     IF y < bady(i) THEN baddirection(i) = 1π     IF y > bady(i) THEN baddirection(i) = 2π     IF y = bady(i) THEN baddirection(i) = 0π    END IFπ    FOR ii = 1 TO 10π     IF shotx(ii) > badx(i) - 25 AND shotx(ii) < badx(i) + 10 THENπ      IF shoty(ii) > bady(i) AND shoty(ii) < bady(i) + 25 THEN baddirection(i) = 1π      IF shoty(ii) < bady(i) AND shoty(ii) > bady(i) - 25 THEN baddirection(i) = 2π      IF shoty(ii) = bady(i) THEN baddirection(i) = ((RND * 1) + 1)π     END IFπ    NEXT iiπ   END IFπ   LINE (badx(i) - 7, bady(i) + 4)-(badx(i) + 4, bady(i) + 4), (100 + i)π   LINE (badx(i) - 7, bady(i) - 4)-(badx(i) + 4, bady(i) - 4), (100 + i)π   LINE (badx(i) - 6, bady(i) + 3)-(badx(i) - 6, bady(i) - 3), (100 + i)π   LINE (badx(i) - 7, bady(i) + 3)-(badx(i) - 7, bady(i) - 3), (100 + i)π   LINE (badx(i) - 8, bady(i) + 3)-(badx(i) - 8, bady(i) - 3), (100 + i)π   LINE (badx(i) + 3, bady(i) + 3)-(badx(i) - 3, bady(i) - 3), 11π   LINE (badx(i) + 3, bady(i) - 3)-(badx(i) - 3, bady(i) + 3), 11π   LINE (badx(i) - 5, bady(i))-(badx(i) + 2, bady(i)), 8π   IF POINT(x + 8, y - 4) = (100 + i) THENπ    FOR ii = 1 TO 10π     CIRCLE (x, y), ii, 12π    NEXT iiπ    PLAY "MFL50C"π    FOR ii = 1 TO 10π     CIRCLE (x, y), ii, 0π     SOUND 100, .5π    NEXT iiπ    GOTO loseπ   END IFπ   IF POINT(x + 8, y + 4) = (100 + i) THENπ    FOR ii = 1 TO 10π     CIRCLE (x, y), ii, 12π    NEXT iiπ    PLAY "MFL50C"π    FOR ii = 1 TO 10π     CIRCLE (x, y), ii, 0π     SOUND 100, .5π    NEXT iiπ    GOTO loseπ   END IFπ   IF POINT(x - 4, y - 4) = (100 + i) THENπ    FOR ii = 1 TO 10π     CIRCLE (x, y), ii, 12π    NEXT iiπ    PLAY "MFL50C"π    FOR ii = 1 TO 10π     CIRCLE (x, y), ii, 0π     SOUND 100, .5π    NEXT iiπ    GOTO loseπ   END IFπ   IF POINT(x - 4, y + 4) = (100 + i) THENπ    FOR ii = 1 TO 10π     CIRCLE (x, y), ii, 12π    NEXT iiπ    PLAY "MFL50C"π    FOR ii = 1 TO 10π     CIRCLE (x, y), ii, 0π     SOUND 100, .5π    NEXT iiπ    GOTO loseπ   END IFπ  END IFπ  IF badshooting(i) = 1 THENπ   PSET (badshotx(i), badshoty(i)), 0π   badshotx(i) = badshotx(i) - 2π   IF badshotx(i) < 0 THEN badshooting(i) = 0π   pixel = POINT(badshotx(i), badshoty(i))π   IF pixel = 100 THENπ    PSET (badshotx(i), badshoty(i)), 0π    shield = shield - 1π    badshotx(i) = -5π    IF shield = -1 THENπ     FOR ii = 1 TO 10π      CIRCLE (x, y), ii, 12π     NEXT iiπ     PLAY "MFL50C"π     FOR ii = 1 TO 15π      CIRCLE (x, y), ii, 0π      SOUND 100, .5π     NEXT iiπ    END IFπ    IF shield = 0 THEN PLAY "MBL25DCDCDC" ELSE PLAY "MBL25C"π    LOCATE 1, 1, 0π    PRINT " Shields:"; shield; " Score:"; scoreπ   END IFπ   PSET (badshotx(i), badshoty(i)), 12π  END IFπ  done = done + dead(i)π NEXT iπ IF done = 10 THEN GOTO win ELSE done = 0π IF shield = -1 THEN GOTO loseπ FOR i = 0 TO 50π  FOR ii = 0 TO delay: NEXT iiπ NEXT iπLOOPπwin:πPLAY "MBL25CDEFGAB"πCLSπLOCATE 11, 18, 0πPRINT "Wow!"πLOCATE 12, 16, 0πPRINT "You Won!"πLOCATE 14, 15, 0πPRINT "Press  Esc"πDO: LOOP UNTIL INKEY$ = CHR$(27)πCLSπLOCATE 11, 11πPRINT "Play Again? (Y,N):"πpa$ = INPUT$(1)πIF UCASE$(pa$) = "Y" THENπ CLEARπ GOTO startπEND IFπENDπlose:πPLAY "MBL25BAGFEDC"πCLSπLOCATE 11, 16, 0πPRINT "Ha Ha Ha"πLOCATE 12, 16, 0πPRINT "You Died"πLOCATE 14, 15, 0πPRINT "Press  Esc"πDO: LOOP UNTIL INKEY$ = CHR$(27)πCLSπLOCATE 11, 11πPRINT "Play Again? (Y,N):"πpa$ = INPUT$(1)πIF UCASE$(pa$) = "Y" THENπ CLEARπ GOTO startπEND IFπENDπquit:πPLAY "MBL25BAGFEDC"πCLSπLOCATE 11, 4, 0πPRINT "Quiters Never Amount To Anything!"πLOCATE 13, 15, 0πPRINT "Press Enter"πDO: LOOP UNTIL INKEY$ = CHR$(13)πENDπJonathan Leger                 HEX-ALIGN 4X4 PUZZEL           [e-mail]             08-06-96 (21:22)       QB, QBasic, PDS        1022 30239    PUZZEL.BAS  DEFINT A-ZππDECLARE SUB Center (s$, l%)πDECLARE SUB PlayPuzzel ()πDECLARE SUB ShowPuzzel ()πDECLARE SUB LoadPuzzel ()πDECLARE SUB CheckHighScore (move.count%)πDECLARE FUNCTION CheckPuzzel ()ππDECLARE SUB ABSOLUTE (var1%, var2%, var3%, var4%, var5%, var6%, offset%)ππ'== BEGIN HEADER ==π'mouse constantsπCONST LB = &H1      'constant for left buttonπCONST RB = &H2      'constant for right buttonπCONST CB = &H4      'constant for center buttonπCONST DC = &H8      'constant for double click (reserved for next release)π'mouse control functionsπDECLARE FUNCTION mouse.enable% ()πDECLARE SUB mouse.disable ()πDECLARE SUB mouse.show ()πDECLARE SUB mouse.hide ()πDECLARE FUNCTION mouse.loadGCR$ (filename$)πDECLARE FUNCTION mouse.loadTCR$ (filename$)π'setsπDECLARE SUB mouse.setpos (x%, y%)πDECLARE SUB mouse.setlimit (x1%, y1%, x2%, y2%)πDECLARE SUB mouse.setspeed (speed.x%, speed.y%)  'limit: -32,768 to 32,767πDECLARE SUB mouse.setGCR (data$)πDECLARE SUB mouse.setTCR (data$)π'getsπDECLARE SUB mouse.get (x%, y%, buttons%)πDECLARE SUB mouse.getpos (x%, y%)πDECLARE SUB mouse.getmovement (x%, y%)πDECLARE SUB mouse.getlastdown (mouse.constant%, x%, y%)πDECLARE SUB mouse.getlastup (mouse.constant%, x%, y%)πDECLARE FUNCTION mouse.getbutton% ()π'shift state constantsπCONST shift = &H3πCONST CTRL = &H4πCONST ALT = &H8π'shift state functionπDECLARE FUNCTION shift.getstate% ()π'== END HEADER ==ππIF NOT mouse.enable THENπ   PRINT "This program requires a mouse."π   ENDπEND IFππmouse.showππCONST TRUE = -1πCONST FALSE = NOT TRUEππDIM SHARED puzzel(1 TO 16), pcos(1 TO 16, 1 TO 2), high.score, move.countππPlayPuzzelππSUB Center (s$, l)ππstring.size = LEN(s$)πper.loc = INSTR(1, s$, "%%")πDO UNTIL per.loc = 0π   string.size = string.size - 3π   per.loc = INSTR(per.loc + 1, s$, "%%")πLOOPππLOCATE l, ((80 - string.size) / 2)ππper.loc = INSTR(1, s$, "%%")πDO UNTIL per.loc = 0π   left.string$ = LEFT$(s$, per.loc - 1)π   string.color = VAL("&H" + MID$(s$, per.loc + 2, 1))π   right.string$ = RIGHT$(s$, LEN(s$) - per.loc - 2)π   s$ = right.string$π   PRINT left.string$;π   COLOR string.colorπ   per.loc = INSTR(1, s$, "%%")πLOOPπPRINT right.string$;ππEND SUBππSUB CheckHighScore (move.count)ππhsfile = FREEFILEπOPEN "puzzel.hsc" FOR BINARY AS hsfileππIF LOF(hsfile) = 0 THENπ   CLOSE hsfileπ   OPEN "puzzel.hsc" FOR OUTPUT AS hsfileπ   move.count = move.count XOR 32767π   PRINT #1, move.countπ   CLOSE hsfileπELSEπ   CLOSE hsfileπ   OPEN "puzzel.hsc" FOR INPUT AS hsfileπ   INPUT #hsfile, high.scoreπ   high.score = high.score XOR 32767π   IF move.count < high.score THENπ      CLOSE hsfileπ      OPEN "puzzel.hsc" FOR OUTPUT AS hsfileπ      move.count = move.count XOR 32767π      PRINT #1, move.countπ   END IFπ   CLOSE hsfileπEND IFππEND SUBππFUNCTION CheckPuzzelππFOR piece = 1 TO 15π   IF puzzel(piece) <> piece THENπ      CheckPuzzel = FALSEπ      EXIT FUNCTIONπ   END IFπNEXT pieceππCheckPuzzel = TRUEππEND FUNCTIONππSUB LoadPuzzelππpuzzel$ = "123456789ABCDEF"ππRANDOMIZE TIMERππFOR piece = 1 TO 15π   ploc = INT(RND * LEN(puzzel$)) + 1π   temp$ = MID$(puzzel$, ploc, 1)π   puzzel$ = LEFT$(puzzel$, ploc - 1) + RIGHT$(puzzel$, LEN(puzzel$) - ploc)π   puzzel(piece) = VAL("&H" + temp$)πNEXT pieceππpiece = 0πFOR y = 1 TO 4π   FOR x = 1 TO 4π      piece = piece + 1π      pcos(piece, 1) = 27 + (x * 5)π      pcos(piece, 2) = 9 + ((y - 1) * 2)π   NEXT xπNEXT yππpuzzel(16) = 0ππhsfile = FREEFILEπOPEN "puzzel.hsc" FOR BINARY AS hsfileππIF LOF(hsfile) = 0 THENπ   CLOSE hsfileπ   OPEN "puzzel.hsc" FOR OUTPUT AS hsfileπ   PRINT #1, 32767 XOR 32767π   high.score = 32767π   CLOSE hsfileπELSEπ   CLOSE hsfileπ   OPEN "puzzel.hsc" FOR INPUT AS hsfileπ   INPUT #1, high.scoreπ   high.score = high.score XOR 32767π   CLOSE hsfileπEND IFππEND SUBππDEFSNG A-Zπ'Disable mouse.π'EXAMPLE:π'  enabled% = mouse.enable  'enable mouseπ'  mouse.show               'show mouseπ'  a$ = INPUT$(1)           'pauseπ'  mouse.disable            'disable mouseπSUB mouse.disableπ  SHARED mouse.exist AS INTEGERπ  IF mouse.exist THENπ    mouse.hideπ    mouse.exist = 0π  END IFπEND SUBππ'Enable mouse for usage. Must be run before any mouse functions (other thanπ'cursor-loading functions) or none will work.π'RETURN:π'  -1 (&hFFFF) if mouse found, else 0.π'EXAMPLE:π'  IF NOT mouse.enable THEN PRINT "No mouse" ELSE PRINT "Mouse found"πFUNCTION mouse.enable%π  SHARED mouse.exist AS INTEGERππ  'store machine language dataπ  SHARED mouse.asm$π  mouse.asm$ = ""π  mouse.asm$ = mouse.asm$ + CHR$(&H55)                            'push bpπ  mouse.asm$ = mouse.asm$ + CHR$(&H89) + CHR$(&HE5)               'mov  bp, spπ  mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HE)   'mov  bx, [bp+0e]π  mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&H7)                'mov  ax, [bx]π  mouse.asm$ = mouse.asm$ + CHR$(&H50)                            'push axπ  mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HC)   'mov  bx, [bp+0c]π  mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&H7)                'mov  cx, [ax]π  mouse.asm$ = mouse.asm$ + CHR$(&H50)                            'push axπ  mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HA)   'mov  bx, [bp+0a]π  mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&HF)                'mov  cx, [bx]π  mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8)   'mov  bx, [bp+08]π  mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&H17)               'mov  dx, [bx]π'  mouse.asm$ = mouse.asm$ + CHR$(&H1E)                            'push dsπ'  mouse.asm$ = mouse.asm$ + CHR$(&H7)                             'pop  esπ  mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)   'mov  bx, [bp+06]π  mouse.asm$ = mouse.asm$ + CHR$(&H8E) + CHR$(&H7)                'mov  es, [bx]π  mouse.asm$ = mouse.asm$ + CHR$(&H5B)                            'pop  bxπ  mouse.asm$ = mouse.asm$ + CHR$(&H58)                            'pop  axπ  mouse.asm$ = mouse.asm$ + CHR$(&HCD) + CHR$(&H33)               'int  33hπ  mouse.asm$ = mouse.asm$ + CHR$(&H53)                            'push bxπ  mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HE)   'mov  bx, [bp+0e]π  mouse.asm$ = mouse.asm$ + CHR$(&H89) + CHR$(&H7)                'mov  [bx], axπ  mouse.asm$ = mouse.asm$ + CHR$(&H58)                            'pop  axπ  mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HC)   'mov  bx, [bp+0c]π  mouse.asm$ = mouse.asm$ + CHR$(&H89) + CHR$(&H7)                'mov  [bx], axπ  mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HA)   'mov  bx, [bp+0a]π  mouse.asm$ = mouse.asm$ + CHR$(&H89) + CHR$(&HF)                'mov  [bx], cxπ  mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8)   'mov  bx, [bp+08]π  mouse.asm$ = mouse.asm$ + CHR$(&H89) + CHR$(&H17)               'mov  [bx], dxπ  mouse.asm$ = mouse.asm$ + CHR$(&H5D)                            'pop  bpπ  mouse.asm$ = mouse.asm$ + CHR$(&HCA) + CHR$(&HA) + CHR$(&H0)    'retf 10ππ  'initialize and check mouse existanceπ  mouse.asmseg% = VARSEG(mouse.asm$)π  mouse.asmoff% = SADD(mouse.asm$)π  ax% = 0π  DEF SEG = mouse.asmseg%π  CALL ABSOLUTE(dummy%, ax%, 0, 0, 0, 0, mouse.asmoff%)π  DEF SEGπ  mouse.exist = ax%ππ  mouse.enable = mouse.existπEND FUNCTIONππ'Gets mouse status (coordinates and button status.)π'COMMENT:π'* Coordinates are in pixels, even if the screen is in text mode.π'INPUT:π'* x% = integer variable to store x coordinateπ'* y% = integer variable to store y coordinateπ'* buttons% = integer variable to store buttons status where:π'  * buttons% becomes LB if left button is pressedπ'  * buttons% becomes RB if right button is pressedπ'  * buttons% becomes CB if center buttons is pressedπ'  * or combination (left button and right button makes buttons% = LB + RB)π'    including double clicks (ie - LB + DC).π'* LB, RB, and CB are mouse constants found in the main module.π'EXAMPLE:π'  CLSπ'  enabled% = mouse.enableπ'  mouse.showπ'  DOπ'    mouse.get x%, y%, buttons%π'    LOCATE 1, 1: PRINT USING "####  ####  ####"; x%; y%; buttons%π'  LOOP WHILE INKEY$ = ""π'  mouse.disableπSUB mouse.get (x%, y%, buttons%)π  SHARED mouse.exist AS INTEGERπ  SHARED mouse.asm$π  mouse.asmseg% = VARSEG(mouse.asm$)π  mouse.asmoff% = SADD(mouse.asm$)π  IF mouse.exist THENπ    DEF SEG = mouse.asmseg%π    CALL ABSOLUTE(dummy%, &H3, bx%, x%, y%, 0, mouse.asmoff%)π    DEF SEGπ  END IFπ  buttons% = 0π  IF bx% AND &H1 THEN buttons% = buttons% OR LBπ  IF bx% AND &H2 THEN buttons% = buttons% OR RBπ  IF bx% AND &H4 THEN buttons% = buttons% OR CBπEND SUBππ'Gets the status of mouse buttons.π'COMMENT:π'* Using mouse.get() function is recommended instead when using bothπ'  mouse.getbutton() and mouse.getpos() functions.π'RETURN:π'* An integer value:π'  * LB for Left Buttonπ'  * RB for Right Buttonπ'  * CB for Center Button (if any)π'  * or combination (left button and right button makes buttons% = LB + RB)π'    including double clicks (ie - LB + DC).π'* LB, RB, and CB are mouse constants found in the main module.π'EXAMPLE:π'  CLSπ'  enabled% = mouse.enableπ'  mouse.showπ'  DOπ'    buttons% = mouse.getbuttonπ'    LOCATE 1, 1: PRINT USING "####"; buttons%π'  LOOP WHILE INKEY$ = ""π'  mouse.disableπFUNCTION mouse.getbutton%π  SHARED mouse.exist AS INTEGERπ  SHARED mouse.asm$π  mouse.asmseg% = VARSEG(mouse.asm$)π  mouse.asmoff% = SADD(mouse.asm$)π  IF mouse.exist THENπ    DEF SEG = mouse.asmseg%π    CALL ABSOLUTE(dummy%, &H3, bx%, 0, 0, 0, mouse.asmoff%)π    DEF SEGπ  END IFπ  ret% = 0π  IF bx% AND &H1 THEN ret% = ret% OR LBπ  IF bx% AND &H2 THEN ret% = ret% OR RBπ  IF bx% AND &H4 THEN ret% = ret% OR CBπ  mouse.getbutton% = ret%πEND FUNCTIONππ'Gets the last coordinate where a mouse button was pressedπ'COMMENT:π'* Coordinates are in pixels, even if the screen is in text mode.π'INPUT:π'* mouse.constant% is a mouse constant of LB (left button), RB (rightπ'  button), or CB (center button) for button press check. No combinationπ'  allowed. Any values other than LB, RB, and CB will default to LB.π'* x% and y% are the variables to store x and y corrdinates where the mouseπ'  button was pressed.π'EXAMPLE:π'  CLSπ'  enabled% = mouse.enableπ'  mouse.showπ'  DOπ'    mouse.getlastdown LB, x%, y%π'    LOCATE 1, 1: PRINT USING "####  ####"; x%; y%π'  LOOP WHILE INKEY$ = ""π'  mouse.disableπSUB mouse.getlastdown (mouse.constant%, x%, y%)π  SHARED mouse.exist AS INTEGERπ  SHARED mouse.asm$π  mouse.asmseg% = VARSEG(mouse.asm$)π  mouse.asmoff% = SADD(mouse.asm$)π  IF mouse.exist THENπ    SELECT CASE mouse.constant%π      CASE LB: button% = 0π      CASE RB: button% = 1π      CASE CB: button% = 2π      CASE ELSE: button% = 0π    END SELECTπ    DEF SEG = mouse.asmseg%π    CALL ABSOLUTE(dummy%, &H5, button%, cx%, dx%, 0, mouse.asmoff%)π    DEF SEGπ    x% = cx%π    y% = dx%π  END IFπEND SUBππ'Gets the last coordinate where a mouse button was releasedπ'COMMENT:π'* Coordinates are in pixels, even if the screen is in text mode.π'INPUT:π'* mouse.constant% is a mouse constant of LB (left button), RB (rightπ'  button), or CB (center button) for button release check. No combinationπ'  allowed.π'* x% and y% are the variables to store x and y corrdinates where the mouseπ'  button was released.π'EXAMPLE:π'  CLSπ'  enabled% = mouse.enableπ'  mouse.showπ'  DOπ'    mouse.getlastup LB, x%, y%π'    LOCATE 1, 1: PRINT USING "####  ####"; x%; y%π'  LOOP WHILE INKEY$ = ""π'  mouse.disableπSUB mouse.getlastup (mouse.constant%, x%, y%)π  SHARED mouse.exist AS INTEGERπ  SHARED mouse.asm$π  mouse.asmseg% = VARSEG(mouse.asm$)π  mouse.asmoff% = SADD(mouse.asm$)π  IF mouse.exist THENπ    SELECT CASE mouse.constant%π      CASE LB: button% = 0π      CASE RB: button% = 1π      CASE CB: button% = 2π      CASE ELSE: button% = 0π    END SELECTπ    DEF SEG = mouse.asmseg%π    CALL ABSOLUTE(dummy%, &H6, button%, cx%, dx%, 0, mouse.asmoff%)π    DEF SEGπ    x% = cx%π    y% = dx%π  END IFπEND SUBππ'Gets the movement of the mouse since last callπ'COMMENT:π'* Coordinates are in pixels, even if the screen is in text mode.π'INPUT:π'* x% and y% are variables to store the horizontal and vertical movements,π'  respectively.π'* Right and Down are positives, Left and Up are negativesπ'EXAMPLE:π'  CLSπ'  enabled% = mouse.enableπ'  mouse.showπ'  DOπ'    mouse.getmovement x%, y%π'    LOCATE 1, 1: PRINT USING "####  ####"; x%; y%π'    SLEEP 1π'  LOOP WHILE INKEY$ = ""π'  mouse.disableπSUB mouse.getmovement (x%, y%)π  SHARED mouse.exist AS INTEGERπ  SHARED mouse.asm$π  mouse.asmseg% = VARSEG(mouse.asm$)π  mouse.asmoff% = SADD(mouse.asm$)π  IF mouse.exist THENπ    DEF SEG = mouse.asmseg%π    CALL ABSOLUTE(dummy%, &HB, 0, cx%, dx%, 0, mouse.asmoff%)π    DEF SEGπ    x% = cx%π    y% = dx%π  END IFπEND SUBππ'Gets mouse coordinates.π'COMMENT:π'* Coordinates are in pixels, even if the screen is in text mode.π'COMMENT:π'* Using mouse.get() function is recommended instead when using bothπ'  mouse.getpos() and mouse.getbutton() functions.π'INPUT:π'* x% = integer variable to store x coordinateπ'* y% = integer variable to store y coordinateπ'EXAMPLE:π'  CLSπ'  enabled% = mouse.enableπ'  mouse.showπ'  DOπ'    mouse.getpos x%, y%π'    LOCATE 1, 1: PRINT USING "####  ####"; x%; y%π'  LOOP WHILE INKEY$ = ""π'  mouse.disableπSUB mouse.getpos (x%, y%)π  SHARED mouse.exist AS INTEGERπ  SHARED mouse.asm$π  mouse.asmseg% = VARSEG(mouse.asm$)π  mouse.asmoff% = SADD(mouse.asm$)π  IF mouse.exist THENπ    DEF SEG = mouse.asmseg%π    CALL ABSOLUTE(dummy%, &H3, 0, x%, y%, 0, mouse.asmoff%)π    DEF SEGπ    x% = (x% / 8) + 1π    y% = (y% / 8) + 1π  END IFπEND SUBππ'Hides mouse cursorπ'EXAMPLE:π'  enabled% = mouse.enable  'enable mouseπ'  mouse.show               'show mouseπ'  a$ = INPUT$(1)           'pauseπ'  mouse.hide               'hide mouseπ'  a$ = INPUT$(1)           'pauseπ'  mouse.disable            'disable mouseπSUB mouse.hideπ  SHARED mouse.exist AS INTEGERπ  SHARED mouse.asm$π  mouse.asmseg% = VARSEG(mouse.asm$)π  mouse.asmoff% = SADD(mouse.asm$)π  SHARED mouse.visible AS INTEGERπ  IF mouse.exist AND mouse.visible THENπ    DEF SEG = mouse.asmseg%π    CALL ABSOLUTE(dummy%, &H2, 0, 0, 0, 0, mouse.asmoff%)π    DEF SEGπ    mouse.visible = 0π  END IFπEND SUBππ'Loads the graphics cursorπ'COMMENT:π'* Requies MS Mouse driver version 3.0 or compatibleπ'INPUT:π'* filename$ is the file name to input the graphics cursor's data from.π'* If filename$ has no extention, it defaults to .GCR (Graphics CuRsor)π'  extention.π'RETURN:π'* Returns the graphics cursor data in the string form.π'EXAMPLE:π'  SCREEN 9   'requires EGA or betterπ'  enabled% = mouse.enableπ'  mouse.showπ'  data$ = mouse.loadGCR$("cursor.gcr")π'  mouse.setGCR data$πFUNCTION mouse.loadGCR$ (filename$)π  IF INSTR(filename$, ".") = 0 THEN filename$ = filename$ + ".GCR"ππ  filenumber% = FREEFILEπ  OPEN filename$ FOR BINARY AS filenumber%π    strn$ = SPACE$(3)π    GET #filenumber%, 1, strn$π    IF strn$ = "GCR" THENπ      strn$ = SPACE$(69)π      GET #filenumber%, 1, strn$π    ELSE strn$ = ""π    END IFπ  CLOSE filenumber%π  mouse.loadGCR$ = strn$πEND FUNCTIONππ'Loads the text cursorπ'COMMENT:π'* Requies MS Mouse driver version 3.0 or compatibleπ'INPUT:π'* filename$ is the file name to input the graphics cursor's data from.π'* If filename$ has no extention, it defaults to .TCR (Text CuRsor) extention.π'RETURN:π'* Returns the text cursor data in the string form.π'EXAMPLE:π'  enabled% = mouse.enableπ'  mouse.showπ'  data$ = mouse.loadTCR$("cursor.tcr")π'  mouse.setTCR data$πFUNCTION mouse.loadTCR$ (filename$)π  IF INSTR(filename$, ".") = 0 THEN filename$ = filename$ + ".TCR"π π  filenumber% = FREEFILEπ  OPEN filename$ FOR BINARY AS filenumber%π    strn$ = SPACE$(3)π    GET #filenumber%, 1, strn$π    IF strn$ = "TCR" THENπ      strn$ = SPACE$(8)π      GET #filenumber%, 1, strn$π    ELSE strn$ = ""π    END IFπ  CLOSE filenumber%π  mouse.loadTCR$ = strn$πEND FUNCTIONππ'Changes the graphics cursorπ'COMMENT:π'* Requies MS Mouse driver version 3.0 or compatibleπ'INPUT:π'* data$ is the graphics cursor data gotten from a file using the functionπ'  mouse.loadGCR().π'EXAMPLE:π'  SCREEN 9   'requires EGA or betterπ'  enabled% = mouse.enableπ'  mouse.showπ'  data$ = mouse.loadGCR$("cursor.gcr")π'  mouse.setGCR data$πSUB mouse.setGCR (data$)π  SHARED mouse.exist AS INTEGERπ  SHARED mouse.asm$π  mouse.asmseg% = VARSEG(mouse.asm$)π  mouse.asmoff% = SADD(mouse.asm$)π  IF mouse.exist AND LEN(data$) = 69 AND LEFT$(data$, 3) = "GCR" THENπ    'get hotx valueπ    hotxstr$ = MID$(data$, 68, 1)π    DEF SEG = VARSEG(hotxstr$)π    bx% = PEEK(SADD(hotxstr$))π    DEF SEGπ    'get hoty valueπ    hotystr$ = MID$(data$, 69, 1)π    DEF SEG = VARSEG(hotystr$)π    cx% = PEEK(SADD(hotystr$))π    DEF SEGπ    'get image shape valuesπ    dx% = SADD(data$) + 3π    es% = VARSEG(data$)π    'executeπ    DEF SEG = mouse.asmseg%π    CALL ABSOLUTE(dummy%, &H9, bx%, cx%, dx%, es%, mouse.asmoff%)π    DEF SEGπ  END IFπEND SUBππ'Sets a "boxed" area for the mouse to move around. It cannot go beyond.π'COMMENT:π'* Coordinates are in pixels, even if the screen is in text mode.π'INPUT:π'* (x1%, y1%) is the top-left coordinate of the box.π'* (x2%, y2%) is the bottom-right coordinate of the box.π'EXAMPLE:π'  enabled% = mouse.enableπ'  mouse.showπ'  mouse.setlimit 50, 50, 300, 100π'  a$ = INPUT$(1)  'wait for a keyπ'  mouse.disableπSUB mouse.setlimit (x1%, y1%, x2%, y2%)π  SHARED mouse.exist AS INTEGERπ  SHARED mouse.asm$π  mouse.asmseg% = VARSEG(mouse.asm$)π  mouse.asmoff% = SADD(mouse.asm$)π  IF mouse.exist THENπ    cx% = x1%π    dx% = x2%π    DEF SEG = mouse.asmseg%π    CALL ABSOLUTE(dummy%, &H7, 0, cx%, dx%, 0, mouse.asmoff%)π    DEF SEGπ    cx% = y1%π    dx% = y2%π    DEF SEG = mouse.asmseg%π    CALL ABSOLUTE(dummy%, &H8, 0, cx%, dx%, 0, mouse.asmoff%)π    DEF SEGπ  END IFπEND SUBππ'Moves the mouse position to (x%, y%)π'COMMENT:π'* Coordinates are in pixels, even if the screen is in text mode.π'NOTES:π'* The inputted values, x% and y%, must be in "pixels", not in "blocks", evenπ'  in text mode.π'EXAMPLE:π'  enabled% = mouse.enableπ'  mouse.showπ'  DOπ'    mouse.setpos 100, 100π'    SLEEP 1π'  LOOP WHILE INKEY$ = ""π'  mouse.disableπSUB mouse.setpos (x%, y%)π  SHARED mouse.exist AS INTEGERπ  SHARED mouse.asm$π  mouse.asmseg% = VARSEG(mouse.asm$)π  mouse.asmoff% = SADD(mouse.asm$)π  IF mouse.exist THENπ    cx% = x%π    dx% = y%π    DEF SEG = mouse.asmseg%π    CALL ABSOLUTE(dummy%, &H4, 0, cx%, dx%, 0, mouse.asmoff%)π    DEF SEGπ  END IFπEND SUBππ'Changes the mouse speedπ'COMMENT:π'* This interrupt service actually sets the ratio between mickey (the small-π'  est movement the mouse can detect) and the pixels.  This function doesπ'  some calculations to make it simulate a speed setting interrupt service.π'   There is aactually a speed setting interrupt service, but it is availableπ'  to MS Mouse Driver version 6.0 and compatibles so I didn't want to doπ'  that.  All the functions in this QBASIC functions are MS Mouse Driver ver-π'  sion 1.0 and compatible with the exception of graphics cursor settingπ'  functions and text cursor setting functions.π'INPUT:π'* x% is the new horizontal mouse speedπ'* y% is the new vertical mouse speedπ'* The minimum value is -32,768 (go backwards) and the maximum value isπ'  32,767, same as the minimum and the maximum value limit of integers.π'EXAMPLE:π'  enabled% = mouse.enableπ'  mouse.showπ'  mouse.setspeed &H7FFF, &H7FFFπ'  a$ = INPUT$(1)  'wait for a keyπ'  mouse.disableπSUB mouse.setspeed (x%, y%)π  SHARED mouse.exist AS INTEGERπ  SHARED mouse.asm$π  mouse.asmseg% = VARSEG(mouse.asm$)π  mouse.asmoff% = SADD(mouse.asm$)π  IF mouse.exist THENπ    DEF SEG = mouse.asmseg%π    CALL ABSOLUTE(dummy%, &HF, 0, (x% XOR &H7FFF), (y% XOR &H7FFF), 0, mouse.asmoff%)π    DEF SEGπ  END IFπEND SUBππ'Changes the text cursorπ'COMMENT:π'* Requies MS Mouse driver version 3.0 or compatibleπ'INPUT:π'* data$ is the text cursor data gotten from a file using the functionπ'  mouse.loadTCR().π'EXAMPLE:π'  enabled% = mouse.enableπ'  mouse.showπ'  data$ = mouse.loadTCR$("cursor.tcr")π'  mouse.setTCR data$πSUB mouse.setTCR (data$)π  SHARED mouse.exist AS INTEGERπ  SHARED mouse.asm$π  mouse.asmseg% = VARSEG(mouse.asm$)π  mouse.asmoff% = SADD(mouse.asm$)π π  IF NOT (mouse.exist AND LEN(data$) = 8 AND LEFT$(data$, 3) = "TCR") THEN EXIT SUBπ π  'get cursor type valueπ  cursortype$ = MID$(data$, 4, 1)π  DEF SEG = VARSEG(cursortype$)π  bx% = PEEK(SADD(cursortype$))π  DEF SEGπ  'get arg1 valueπ  arg1h$ = MID$(data$, 5, 1)π  DEF SEG = VARSEG(arg1h$)π  argh% = PEEK(SADD(arg1h$))π  DEF SEGπ  arg1l$ = MID$(data$, 6, 1)π  DEF SEG = VARSEG(arg1l$)π  argl% = PEEK(SADD(arg1l$))π  DEF SEGπ  cx% = (argh% AND &H7F) * &H100 + argl%π   IF argh% AND &H80 THEN cx% = cx% OR &H8000π  'get arg2 valueπ  arg2h$ = MID$(data$, 7, 1)π  DEF SEG = VARSEG(arg2h$)π  argh% = PEEK(SADD(arg2h$))π  DEF SEGπ  arg2l$ = MID$(data$, 8, 1)π  DEF SEG = VARSEG(arg2l$)π  argl% = PEEK(SADD(arg2l$))π  DEF SEGπ  dx% = (argh% AND &H7F) * &H100 + argl%π   IF argh% AND &H80 THEN dx% = dx% OR &H8000π  'executeπ  DEF SEG = mouse.asmseg%π  CALL ABSOLUTE(dummy%, &HA, bx%, cx%, dx%, 0, mouse.asmoff%)π  DEF SEGπEND SUBππ'Shows the mouse. Must have been enabled first.π'EXAMPLE:π'  enabled% = mouse.enable  'enable mouseπ'  mouse.show               'show mouseπ'  a$ = INPUT$(1)           'pauseπ'  mouse.disable            'disable mouseπSUB mouse.showπ  SHARED mouse.exist AS INTEGERπ  SHARED mouse.asm$π  mouse.asmseg% = VARSEG(mouse.asm$)π  mouse.asmoff% = SADD(mouse.asm$)π  SHARED mouse.visible AS INTEGERπ  IF mouse.exist AND NOT mouse.visible THENπ    DEF SEG = mouse.asmseg%π    CALL ABSOLUTE(dummy%, &H1, 0, 0, 0, 0, mouse.asmoff%)π    DEF SEGπ    mouse.visible = 1π  END IFπEND SUBππDEFINT A-ZπSUB PlayPuzzelππSCREEN 0πWIDTH 80, 25πCLSππLoadPuzzelππCOLOR 10πCenter "%%9[ %%FHex%%B-%%FAlign %%9]", 1πCOLOR 7: LOCATE 10, 8: PRINT "Turn"πCOLOR 9: LOCATE 11, 5: PRINT "(";πCOLOR 11: PRINT "S";πCOLOR 9: PRINT ")";πCOLOR 7: PRINT "ound OFF"πCOLOR 8: LOCATE 12, 1: PRINT "[";πCOLOR 4: PRINT "Right Mouse Click";πCOLOR 8: PRINT "]"ππLOCATE 3, 1: COLOR 3πPRINT "[ The object of the game is to put all of the hexidecimal numbers in numerical ]"πPRINT "[ order (1 2 3 4 5 6 7 8 9 A B C D E F) in the fewest number of moves possible ]";ππCOLOR 8ππt$ = CHR$(218) + STRING$(20, 196) + CHR$(191)πm$ = CHR$(179) + STRING$(20, " ") + CHR$(179)πb$ = CHR$(192) + STRING$(20, 196) + CHR$(217)ππLOCATE 8, 29: PRINT t$πFOR y = 9 TO 16π   LOCATE y, 29: PRINT m$πNEXT yπLOCATE 16, 29: PRINT b$ππShowPuzzelππlast.error# = TIMERπlast.sound.change# = TIMERπlast.error.loc = 0πmove.count = 0πsound.on = TRUEππDOππ   mouse.getpos mouse.x, mouse.yπ   button = mouse.getbuttonπ   move.okay = FALSEπ   in.grid = FALSEππ   IF (button = 2 OR (mouse.x >= 5 AND mouse.x <= 7 AND mouse.y = 11 AND button = 1)) AND (TIMER - last.sound.change# > .25) THENπ      last.sound.change# = TIMERπ      IF sound.on THENπ         sound.on = FALSEπ         SCREEN , , , 1π         mouse.hideπ         COLOR 7π         LOCATE 11, 13: PRINT "ON "π         PCOPY 1, 0π         mouse.showπ      ELSEπ         sound.on = TRUEπ         mouse.hideπ         SCREEN , , , 1π         COLOR 7π         LOCATE 11, 13: PRINT "OFF"π         PCOPY 1, 0π         mouse.showπ      END IFπ   END IFππ   key$ = INKEY$π   IF key$ <> "" THENπ      SELECT CASE key$π            CASE CHR$(27)π               EXIT DOπ            CASE "s", "S"π               IF sound.on THENπ                  sound.on = FALSEπ                  SCREEN , , , 1π                  mouse.hideπ                  COLOR 7π                  LOCATE 11, 13: PRINT "ON "π                  PCOPY 1, 0π                  mouse.showπ               ELSEπ                  sound.on = TRUEπ                  mouse.hideπ                  SCREEN , , , 1π                  COLOR 7π                  LOCATE 11, 13: PRINT "OFF"π                  PCOPY 1, 0π                  mouse.showπ               END IFπ            CASE CHR$(0) + CHR$(75)    'Left keyπ            CASE CHR$(0) + CHR$(77)    'Right keyπ            CASE CHR$(0) + CHR$(72)    'Up keyπ            CASE CHR$(0) + CHR$(80)    'Down keyπ      END SELECTπ   ELSEπ      FOR piece = 1 TO 16π         IF (mouse.x >= pcos(piece, 1) - 1 AND mouse.x <= pcos(piece, 1) + 1) AND (mouse.y = pcos(piece, 2) AND button = 1) THENπ            in.grid = TRUEπ            IF piece > 1 THENπ               IF puzzel(piece - 1) = 0 AND NOT (piece MOD 4 = 1) THENπ                  puzzel(piece - 1) = puzzel(piece)π                  puzzel(piece) = 0π                  IF sound.on THENπ                     FOR z = 100 TO 500 STEP 100π                        SOUND 100 + z, .5π                     NEXT zπ                  END IFπ                  move.okay = TRUEπ                  last.error# = TIMERπ                  move.count = move.count + 1π                  ShowPuzzelπ                  EXIT FORπ               END IFπ            END IFπ            IF piece < 16 THENπ               IF puzzel(piece + 1) = 0 AND piece MOD 4 THENπ                  puzzel(piece + 1) = puzzel(piece)π                  puzzel(piece) = 0π                  IF sound.on THENπ                     FOR z = 100 TO 500 STEP 100π                        SOUND 100 + z, .5π                     NEXT zπ                  END IFπ                  move.okay = TRUEπ                  last.error# = TIMERπ                  move.count = move.count + 1π                  ShowPuzzelπ                  EXIT FORπ               END IFπ            END IFπ            IF piece < 13 THENπ               IF puzzel(piece + 4) = 0 THENπ                  puzzel(piece + 4) = puzzel(piece)π                  puzzel(piece) = 0π                  IF sound.on THENπ                     FOR z = 100 TO 500 STEP 100π                        SOUND 100 + z, .5π                     NEXT zπ                  END IFπ                  move.okay = TRUEπ                  last.error# = TIMERπ                  move.count = move.count + 1π                  ShowPuzzelπ                  EXIT FORπ               END IFπ            END IFπ            IF piece > 4 THENπ               IF puzzel(piece - 4) = 0 THENπ                  puzzel(piece - 4) = puzzel(piece)π                  puzzel(piece) = 0π                  IF sound.on THENπ                     FOR z = 100 TO 500 STEP 100π                        SOUND 100 + z, .5π                     NEXT zπ                  END IFπ                  move.okay = TRUEπ                  last.error# = TIMERπ                  move.count = move.count + 1π                  ShowPuzzelπ                  EXIT FORπ               END IFπ            END IFπ         END IFπ         IF puzzel(piece) = 0 AND (mouse.x >= pcos(piece, 1) - 1 AND mouse.x <= pcos(piece, 1) + 1) AND (mouse.y = pcos(piece, 2) AND button = 1) THENπ            move.okay = TRUEπ         END IFπ      NEXT pieceπ π      IF sound.on THENπ         IF NOT move.okay AND button = 1 AND NOT in.grid THENπ            IF (TIMER - last.error# >= .25) THENπ               SOUND 100, 3π               last.error# = TIMERπ            END IFπ         ELSEIF NOT move.okay AND button = 1 AND in.grid THENπ            IF (TIMER - last.error# >= .25) THENπ               FOR z = 500 TO 1000 STEP 50π                  SOUND 500 + z, .1π               NEXT zπ               FOR z = 500 TO 1000 STEP 50π                  SOUND 500 + z, .1π               NEXT zπ               last.error# = TIMERπ            END IFπ         END IFπ      END IFππ   END IFππ   IF CheckPuzzel = TRUE THENπ      SCREEN , , , 1π      COLOR 15π      Center "You've won!", 19π      CheckHighScore move.countπ      ENDπ   END IFππLOOPππEND SUBππDEFSNG A-Zπ'Gets shift state.π'RETURN:π'* 0 if no shift key pressedπ'* ALT if Alt key pressedπ'* CTRL if Ctrl key pressedπ'* SHIFT if Shift key pressedπ'* These may be in combination.  For example, if Ctrl-Alt is pressed, thenπ'  return is CTRL + ALT.π'* ALT, CTRL, and SHIFT are shift constants defined in the main module.π'EXAMPLE:π'  CLSπ'  enabled% = mouse.enableπ'  mouse.showπ'  DOπ'    mouse.get x%, y%, buttons%π'    shiftstate% = shift.getstate%π'    IF buttons% THENπ'      LOCATE 1, 1: PRINT SPACE$(79); : LOCATE 1, 1π'      SELECT CASE shiftstate%π'        CASE 0: PRINT "Mouse button was pressed without any shift keys."π'        CASE ALT: PRINT "Mouse button and Alt key pressed."π'        CASE CTRL: PRINT "Mouse button and Ctrl key pressed."π'        CASE SHIFT: PRINT "Mouse button and Shift key pressed."π'      END SELECTπ'    END IFπ'  LOOP WHILE INKEY$ = ""πFUNCTION shift.getstate%π  DEF SEG = 0π  state% = PEEK(&H417) AND &HFπ  DEF SEGπ  IF (state% AND &H3) THEN state% = (state% OR &H3)π  shift.getstate% = state%πEND FUNCTIONππDEFINT A-ZπSUB ShowPuzzelππmouse.hideππPCOPY 0, 1πSCREEN , , 1ππCOLOR 3πpiece = 0πFOR y = 1 TO 4π   FOR x = 1 TO 4π      piece = piece + 1π      LOCATE pcos(piece, 2), pcos(piece, 1) - 1π      IF puzzel(piece) = 0 THENπ         COLOR 7π         PRINT "[■] "π         COLOR 3π      ELSEπ         COLOR 3π         PRINT "[";π         COLOR 11π         PRINT HEX$(puzzel(piece));π         COLOR 3π         PRINT "] "π      END IFπ   NEXT xπNEXT yππLOCATE 23, 20πCOLOR 14: PRINT "Best Score:";πCOLOR 12: PRINT high.scoreππLOCATE 23, 45πCOLOR 15: PRINT "Your Score:";πCOLOR 11: PRINT move.countππPCOPY 1, 0πSCREEN , , , 0ππmouse.showππEND SUBπAlex Makris                    WORLD CUP SOCCER '94           pages.prodigy.com/gamersp      04-06-96 (17:04)       QB, QBasic, PDS        1430 62547    WC94.BAS    'No cool nicknames just By Alex(A|@*) Makris CRPY26C     πDECLARE SUB USA : DECLARE SUB SWITZERLANDπDECLARE SUB ROMANIA : DECLARE SUB COLOMBIAπDECLARE SUB BRAZIL : DECLARE SUB CAMEROONπDECLARE SUB SWEDEN : DECLARE SUB RUSSIAπDECLARE SUB GERMANY : DECLARE SUB SPAINπDECLARE SUB SOUTHKOREA : DECLARE SUB BOLIVIAπDECLARE SUB ARGENTINA : DECLARE SUB NIGERIAπDECLARE SUB BULGARIA : DECLARE SUB GREECEπDECLARE SUB IRELAND : DECLARE SUB NORWAYπDECLARE SUB ITALY : DECLARE SUB MEXICOπDECLARE SUB BELGIUM : DECLARE SUB NETHERLANDSπDECLARE SUB SAUDIARABIA : DECLARE SUB MOROCCOπDECLARE SUB FLASHER : DECLARE SUB INTROπDECLARE SUB LOGO : DECLARE SUB LOGOCOVERπDECLARE SUB MENU : DECLARE SUB LOGOFLASHπDECLARE SUB LOGOLETTERCOVER : DECLARE SUB STRIKERπDECLARE SUB SOCCERFIELD : DECLARE SUB PLAYERπDECLARE SUB INSTRUCTIONS : DECLARE SUB CONTROLSπDECLARE SUB SELECTION : DECLARE SUB DEMOπDECLARE SUB MAINGAME : DECLARE SUB DRAWSTUFFπDECLARE SUB INTERPRET : DECLARE SUB GOALπ                                                            πUSANAME1$ = "Ernie Stewart": USANAME2$ = "Cobi Jones"πUSAGOALIE$ = "Tony Meola"πSWITZERLANDNAME1$ = "Georges Bregy"πSWITZERLANDNAME2$ = "Adrian Knup"πSWITZERLANDGOALIE$ = "Marco Pasolo"πROMANIANAME1$ = "Ion Vladoiu"πROMANIANAME2$ = "Gheorghe Hagi"πROMANIAGOALIE$ = "Bogdan Stelea"πCOLOMBIANAME1$ = "Adolfo Valencia"πCOLOMBIANAME2$ = "Faustino Asprilla"πCOLOMBIAGOALIE$ = "Rene Higuita"πBRAZILNAME1$ = "Rai": BRAZILNAME2$ = "Romario"πBRAZILGOALIE$ = "Taffarel"πCAMEROONNAME1$ = "Stephen Tataw"πCAMEROONNAME2$ = "Raymond Kalla"πCAMEROONGOALIE$ = "Joseph-Antoine Bell"πSWEDENNAME1$ = "Martin 'Black Pearl' Dahlin"πSWEDENNAME2$ = "Tomas Brolin"πSWEDENGOALIE$ = "Thomas Ravelli"πRUSSIANAME1$ = "Victor Onopko"πRUSSIANAME2$ = "Sergei Yuran"πRUSSIAGOALIE$ = "Dmitri Kharine"πGERMANYNAME1$ = "Jurgen Klinsmann"πGERMANYNAME2$ = "Lothar Matthaus"πGERMANYGOALIE$ = "Bodo Illgner"πSPAINNAME1$ = "Juan Andoni Goicoechea"πSPAINNAME2$ = "Julio Salinas"πSPAINGOALIE$ = "Adoni Zubizarreta"πSOUTHKOREANAME1$ = "Jung-Won Seo"πSOUTHKOREANAME2$ = "Myung-Bo Hong"πSOUTHKOREAGOALIE$ = "In-Young Choi"πBOLIVIANAME1$ = "Luis Critaldo"πBOLIVIANAME2$ = "Julio Cesar Baldivieso"πBOLIVIAGOALIE$ = "Carlos Trucco"πARGENTINANAME1$ = "Diego Maradona"πARGENTINANAME2$ = "Gabriel Batistuta"πARGENTINAGOALIE$ = "Sergio Goycochea"πNIGERIANAME1$ = "Rashidi Yekini"πNIGERIANAME2$ = "Daniel Amokachi"πNIGERIAGOALIE$ = "Peter Rufai"πBULGARIANAME1$ = "Hristo Stoichkov"πBULGARIANAME2$ = "Yordan Lechkov"πBULGARIAGOALIE$ = "Antonis Minou"πGREECENAME1$ = "Anastassios Mitropoulos"πGREECENAME2$ = "Dimitris Saravakos"πGREECEGOALIE$ = "Borislav Mikhailov"πIRELANDNAME1$ = "Tommy Coyne"πIRELANDNAME2$ = "Paul McGrath"πIRELANDGOALIE$ = "Patrick Bonner"πNORWAYNAME1$ = "Henning Berg"πNORWAYNAME2$ = "Oyvind Leonhardsen"πNORWAYGOALIE$ = "Erik Thorstvedt"πITALYNAME1$ = "Roberto Baggio"πITALYNAME2$ = "Pierluigi Casiraghi"πITALYGOALIE$ = "Luca Marchegiani"πMEXICONAME1$ = "Alberto Garcia Aspe"πMEXICONAME2$ = "Luis Garcia"πMEXICOGOALIE$ = "Jorge Campos"πBELGIUMNAME1$ = "Marc Degryse"πBELGIUMNAME2$ = "Luc Nillis"πBELGIUMGOALIE$ = "Michel Prued'Homme"πNETHERLANDSNAME1$ = "Wim Jonk"πNETHERLANDSNAME2$ = "Gaston Taument"πNETHERLANDSGOALIE$ = "Ed de Goey"πSAUDIARABIANAME1$ = "Fuad Anwar Amin"πSAUDIARABIANAME2$ = "Majed Mohammed"πSAUDIARABIAGOALIE$ = "Mohammed Al-Deayea"πMOROCCONAME1$ = "Mohammed Lashaf"πMOROCCONAME2$ = "Mustapha El Hadaoui"πMOROCCOGOALIE$ = "Khalil Azmi"πSCREEN 9: DIM MINI%(1 TO 500)πPAINT (320, 175), 2πGET (100, 100)-(130, 115), MINI%πCLS : GOSUB INTROπ1 GOSUB MENUπππX = 450: Y = 100πGOSUB STRIKER: BALLX = 100: BALLY = 100πGOSUB SELECTION: GOSUB MAINGAMEπGOTO 1πENDπUSA:                                                     πSTEAL = 45: SPEED = 8: HANDS = 46πCLS : LOCATE 1, 38: PRINT "USA"πFOR T = 15 TO 175: LINE (0, T)-(640, T), 4: NEXT TπFOR T = 27 TO 40: LINE (200, T)-(640, T), 15: NEXT TπFOR T = 52 TO 65: LINE (200, T)-(640, T), 15: NEXT TπFOR T = 77 TO 90: LINE (200, T)-(640, T), 15: NEXT TπFOR T = 102 TO 115: LINE (0, T)-(640, T), 15: NEXT TπFOR T = 127 TO 140: LINE (0, T)-(640, T), 15: NEXT TπFOR T = 152 TO 165: LINE (0, T)-(640, T), 15: NEXT TπFOR T = 15 TO 101: LINE (0, T)-(200, T), 1: NEXT TπLOCATE 15, 25: PRINT "Player 1: "; USANAME1$πLOCATE 17, 25: PRINT "Player 2: "; USANAME2$πLOCATE 19, 27: PRINT "Goalie: "; USAGOALIE$πNAME1$ = USANAME1$: NAME2$ = USANAME2$πGOALIE$ = USAGOALIE$πRETURNπGREECE:                                                  πSTEAL = 15: SPEED = 2: HANDS = 22πCLS : LOCATE 1, 36: PRINT "Greece"πFOR T = 15 TO 175: LINE (0, T)-(640, T), 9: NEXT TπFOR T = 27 TO 40: LINE (200, T)-(640, T), 15: NEXT TπFOR T = 77 TO 90: LINE (200, T)-(640, T), 15: NEXT TπFOR T = 102 TO 115: LINE (0, T)-(640, T), 15: NEXT TπFOR T = 127 TO 140: LINE (0, T)-(640, T), 15: NEXT TπFOR T = 152 TO 165: LINE (0, T)-(640, T), 15: NEXT TπFOR T = 15 TO 101: LINE (0, T)-(200, T), 9: NEXT TπFOR T = 52 TO 65: LINE (0, T)-(640, T), 15: NEXT TπFOR T = 92 TO 108: LINE (T, 15)-(T, 102), 15: NEXT TπLOCATE 15, 25: PRINT "Player 1: "; GREECENAME1$πLOCATE 17, 25: PRINT "Player 2: "; GREECENAME2$πLOCATE 19, 27: PRINT "Goalie: "; GREECEGOALIE$πNAME1$ = GREECENAME1$: NAME2$ = GREECENAME2$πGOALIE$ = GREECEGOALIE$πRETURNπCOLOMBIA:                                                πSTEAL = 75: SPEED = 13: HANDS = 49πCLS : LOCATE 1, 35: PRINT "Colombia"πFOR T = 15 TO 88: LINE (0, T)-(640, T), 14: NEXT TπFOR T = 89 TO 122: LINE (0, T)-(640, T), 1: NEXT TπFOR T = 123 TO 175: LINE (0, T)-(640, T), 4: NEXT TπLOCATE 15, 25: PRINT "Player 1: "; COLOMBIANAME1$πLOCATE 17, 25: PRINT "Player 2: "; COLOMBIANAME2$πLOCATE 19, 27: PRINT "Goalie: "; COLOMBIAGOALIE$πNAME1$ = COLOMBIANAME1$: NAME2$ = COLOMBIANAME2$πGOALIE$ = COLOMBIAGOALIE$πRETURNπRUSSIA:                                                  πSTEAL = 35: SPEED = 6: HANDS = 37πππCLS : LOCATE 1, 35: PRINT "Russia"πFOR T = 15 TO 68: LINE (0, T)-(640, T), 15: NEXT TπFOR T = 69 TO 122: LINE (0, T)-(640, T), 1: NEXT TπFOR T = 123 TO 175: LINE (0, T)-(640, T), 4: NEXT TπLOCATE 15, 25: PRINT "Player 1: "; RUSSIANAME1$πLOCATE 17, 25: PRINT "Player 2: "; RUSSIANAME2$πLOCATE 19, 27: PRINT "Goalie: "; RUSSIAGOALIE$πNAME1$ = RUSSIANAME1$: NAME2$ = RUSSIANAME2$πGOALIE$ = RUSSIAGOALIE$πRETURNπBOLIVIA:                                                 πSTEAL = 49: SPEED = 10: HANDS = 41πCLS : LOCATE 1, 36: PRINT "Bolivia"πFOR T = 15 TO 68: LINE (0, T)-(640, T), 12: NEXT TπFOR T = 69 TO 122: LINE (0, T)-(640, T), 14: NEXT TπFOR T = 123 TO 175: LINE (0, T)-(640, T), 10: NEXT TπLOCATE 15, 25: PRINT "Player 1: "; BOLIVIANAME1$πLOCATE 17, 25: PRINT "Player 2: "; BOLIVIANAME2$πLOCATE 19, 27: PRINT "Goalie: "; BOLIVIAGOALIE$πNAME1$ = BOLIVIANAME1$: NAME2$ = BOLIVIANAME2$πGOALIE$ = BOLIVIAGOALIE$πRETURNπGERMANY:                                                 πSTEAL = 93: SPEED = 17: HANDS = 70πCLS : LOCATE 1, 35: PRINT "Germany": FOR T = 15 TO 68πLINE (0, T)-(640, T), 0: NEXT TπFOR T = 69 TO 122: LINE (0, T)-(640, T), 4: NEXT TπFOR T = 123 TO 175: LINE (0, T)-(640, T), 14: NEXT TπLINE (0, 15)-(640, 15), 15: LINE (0, 15)-(0, 68), 15πLINE (639, 15)-(639, 68), 15πLOCATE 15, 25: PRINT "Player 1: "; GERMANYNAME1$πLOCATE 17, 25: PRINT "Player 2: "; GERMANYNAME2$πLOCATE 19, 27: PRINT "Goalie: "; GERMANYGOALIE$πNAME1$ = GERMANYNAME1$: NAME2$ = GERMANYNAME2$πGOALIE$ = GERMANYGOALIE$πRETURNπSPAIN:                                                   πSTEAL = 63: SPEED = 13: HANDS = 54πCLS : LOCATE 1, 35: PRINT "Spain"πFOR T = 15 TO 68: LINE (0, T)-(640, T), 4: NEXT TπFOR T = 69 TO 122: LINE (0, T)-(640, T), 14: NEXT TπFOR T = 123 TO 175: LINE (0, T)-(640, T), 4: NEXT TπLOCATE 15, 25: PRINT "Player 1: "; SPAINNAME1$πLOCATE 17, 25: PRINT "Player 2: "; SPAINNAME2$πLOCATE 19, 27: PRINT "Goalie: "; SPAINGOALIE$πNAME1$ = SPAINNAME1$: NAME2$ = SPAINNAME2$πGOALIE$ = SPAINGOALIE$πRETURNπARGENTINA:                                               πSTEAL = 74: SPEED = 13: HANDS = 61πCLS : LOCATE 1, 36: PRINT "Argentina"πFOR T = 15 TO 68: LINE (0, T)-(640, T), 9: NEXT TπFOR T = 69 TO 122: LINE (0, T)-(640, T), 15: NEXT TπFOR T = 123 TO 175: LINE (0, T)-(640, T), 9: NEXT TπππCIRCLE (320, 95), 20, 14: PAINT (320, 95), 14πLOCATE 15, 25: PRINT "Player 1: "; ARGENTINANAME1$πLOCATE 17, 25: PRINT "Player 2: "; ARGENTINANAME2$πLOCATE 19, 27: PRINT "Goalie: "; ARGENTINAGOALIE$πNAME1$ = ARGENTINANAME1$: NAME2$ = ARGENTINANAME2$πGOALIE$ = ARGENTINAGOALIE$πRETURNπBULGARIA:                                                πSTEAL = 73: SPEED = 11: HANDS = 53πCLS : LOCATE 1, 35: PRINT "Bulgaria"πFOR T = 15 TO 68: LINE (0, T)-(640, T), 15: NEXT TπFOR T = 69 TO 122: LINE (0, T)-(640, T), 10: NEXT TπFOR T = 123 TO 175: LINE (0, T)-(640, T), 4: NEXT TπLOCATE 15, 25: PRINT "Player 1: "; BULGARIANAME1$πLOCATE 17, 25: PRINT "Player 2: "; BULGARIANAME2$πLOCATE 19, 27: PRINT "Goalie: "; BULGARIAGOALIE$πNAME1$ = BULGARIANAME1$: NAME2$ = BULGARIANAME2$πGOALIE$ = BULGARIAGOALIE$πRETURNπNETHERLANDS:                                             πSTEAL = 86: SPEED = 17: HANDS = 68πCLS : LOCATE 1, 33: PRINT "Netherlands"πFOR T = 15 TO 68: LINE (0, T)-(640, T), 4: NEXT TπFOR T = 69 TO 122: LINE (0, T)-(640, T), 15: NEXT TπFOR T = 123 TO 175: LINE (0, T)-(640, T), 1: NEXT TπLOCATE 15, 25: PRINT "Player 1: "; NETHERLANDSNAME1$πLOCATE 17, 25: PRINT "Player 2: "; NETHERLANDSNAME2$πLOCATE 19, 27: PRINT "Goalie: "; NETHERLANDSGOALIE$πNAME1$ = NETHERLANDSNAME1$: NAME2$ = NETHERLANDSNAME2$πGOALIE$ = NETHERLANDSGOALIE$πRETURNπSAUDIARABIA:                                             πSTEAL = 18: SPEED = 4: HANDS = 23πCLS : LOCATE 1, 32: PRINT "Saudi Arabia"πFOR T = 15 TO 175: LINE (0, T)-(640, T), 2: NEXT TπFOR H = 1 TO 50: LET R = INT(RND(1) * 400) + 120πLET S = INT(RND(1) * 30) + 65πLET R2 = INT(RND(1) * 400) + 120πLET S2 = INT(RND(1) * 30) + 95πLINE (R, S)-(R2, S2), 15: NEXT HπFOR T = 0 TO 7πLINE (140 + (8 * T), 135 + T)-(490, 135 + T): NEXT TπCIRCLE (490, 141), 8, 15: PAINT (492, 143), 15, 15πFOR T = 420 TO 425: LINE (T, 125)-(T, 152), 15: NEXT TπLOCATE 15, 25: PRINT "Player 1: "; SAUDIARABIANAME1$πLOCATE 17, 25: PRINT "Player 2: "; SAUDIARABIANAME2$πLOCATE 19, 27: PRINT "Goalie: "; SAUDIARABIAGOALIE$πNAME1$ = SAUDIARABIANAME1$: NAME2$ = SAUDIARABIANAME2$πGOALIE$ = SAUDIARABIAGOALIE$πRETURNπROMANIA:                                                 πSTEAL = 32: SPEED = 8: HANDS = 42πCLS : LOCATE 1, 35: PRINT "Romania"πFOR T = 1 TO 213: LINE (T, 15)-(T, 175), 1: NEXT TπππFOR T = 214 TO 427: LINE (T, 15)-(T, 175), 14: NEXT TπFOR T = 428 TO 640: LINE (T, 15)-(T, 175), 4: NEXT TπLOCATE 15, 25: PRINT "Player 1: "; ROMANIANAME1$πLOCATE 17, 25: PRINT "Player 2: "; ROMANIANAME2$πLOCATE 19, 27: PRINT "Goalie: "; ROMANIAGOALIE$πNAME1$ = ROMANIANAME1$: NAME2$ = ROMANIANAME2$πGOALIE$ = ROMANIAGOALIE$πRETURNπCAMEROON:                                                πSTEAL = 50: SPEED = 10: HANDS = 46πCLS : LOCATE 1, 36: PRINT "Cameroon"πFOR T = 1 TO 213: LINE (T, 15)-(T, 175), 10: NEXT TπFOR T = 214 TO 427: LINE (T, 15)-(T, 175), 12: NEXT TπFOR T = 428 TO 640: LINE (T, 15)-(T, 175), 14: NEXT TπLOCATE 15, 25: PRINT "Player 1: "; CAMEROONNAME1$πLOCATE 17, 25: PRINT "Player 2: "; CAMEROONNAME2$πLOCATE 19, 27: PRINT "Goalie: "; CAMEROONGOALIE$πNAME1$ = CAMEROONNAME1$: NAME2$ = CAMEROONNAME2$πGOALIE$ = CAMEROONGOALIE$πRETURNπNIGERIA:                                                 πSTEAL = 43: SPEED = 7: HANDS = 38πCLS : LOCATE 1, 36: PRINT "Nigeria"πFOR T = 1 TO 213: LINE (T, 15)-(T, 175), 2: NEXT TπFOR T = 214 TO 427: LINE (T, 15)-(T, 175), 15: NEXT TπFOR T = 428 TO 640: LINE (T, 15)-(T, 175), 2: NEXT TπLOCATE 15, 25: PRINT "Player 1: "; NIGERIANAME1$πLOCATE 17, 25: PRINT "Player 2: "; NIGERIANAME2$πLOCATE 19, 27: PRINT "Goalie: "; NIGERIAGOALIE$πNAME1$ = NIGERIANAME1$: NAME2$ = NIGERIANAME2$πGOALIE$ = NIGERIAGOALIE$πRETURNπIRELAND:                                                 πSTEAL = 69: SPEED = 15: HANDS = 58πCLS : LOCATE 1, 35: PRINT "Ireland"πFOR T = 1 TO 213: LINE (T, 15)-(T, 175), 2: NEXT TπFOR T = 214 TO 427: LINE (T, 15)-(T, 175), 15: NEXT TπFOR T = 428 TO 640: LINE (T, 15)-(T, 175), 12: NEXT TπFOR T = 428 TO 640 STEP 2: LINE (T, 15)-(T, 175), 14πNEXT TπLOCATE 15, 25: PRINT "Player 1: "; IRELANDNAME1$πLOCATE 17, 25: PRINT "Player 2: "; IRELANDNAME2$πLOCATE 19, 27: PRINT "Goalie: "; IRELANDGOALIE$πNAME1$ = IRELANDNAME1$: NAME2$ = IRELANDNAME2$πGOALIE$ = IRELANDGOALIE$πRETURNπITALY:                                                   πSTEAL = 92: SPEED = 20: HANDS = 70πCLS : LOCATE 1, 36: PRINT "Italy"πFOR T = 1 TO 213: LINE (T, 15)-(T, 175), 2: NEXT TπFOR T = 214 TO 427: LINE (T, 15)-(T, 175), 15: NEXT TπFOR T = 428 TO 640: LINE (T, 15)-(T, 175), 4: NEXT TπLOCATE 15, 25: PRINT "Player 1: "; ITALYNAME1$πLOCATE 17, 25: PRINT "Player 2: "; ITALYNAME2$πππLOCATE 19, 27: PRINT "Goalie: "; ITALYGOALIE$πNAME1$ = ITALYNAME1$: NAME2$ = ITALYNAME2$πGOALIE$ = ITALYGOALIE$πRETURNπMEXICO:                                                  πSTEAL = 53: SPEED = 13: HANDS = 56πCLS : LOCATE 1, 36: PRINT "Mexico"πFOR T = 1 TO 213: LINE (T, 15)-(T, 175), 2: NEXT TπFOR T = 214 TO 427: LINE (T, 15)-(T, 175), 15: NEXT TπFOR T = 428 TO 640: LINE (T, 15)-(T, 175), 4: NEXT TπCIRCLE (320, 95), 20, 6: PAINT (320, 95), 6πLOCATE 15, 25: PRINT "Player 1: "; MEXICONAME1$πLOCATE 17, 25: PRINT "Player 2: "; MEXICONAME2$πLOCATE 19, 27: PRINT "Goalie: "; MEXICOGOALIE$πNAME1$ = MEXICONAME1$: NAME2$ = MEXICONAME2$πGOALIE$ = MEXICOGOALIE$πRETURNπBELGIUM:                                                 πSTEAL = 57: SPEED = 14: HANDS = 55πCLS : LOCATE 1, 35: PRINT "Belgium"πFOR T = 1 TO 213: LINE (T, 15)-(T, 175), 0: NEXT TπFOR T = 214 TO 427: LINE (T, 15)-(T, 175), 14: NEXT TπFOR T = 428 TO 640: LINE (T, 15)-(T, 175), 4: NEXT TπLINE (0, 15)-(213, 15), 15: LINE (0, 15)-(0, 175), 15πLINE (0, 175)-(213, 175), 15πLOCATE 15, 25: PRINT "Player 1: "; BELGIUMNAME1$πLOCATE 17, 25: PRINT "Player 2: "; BELGIUMNAME2$πLOCATE 19, 27: PRINT "Goalie: "; BELGIUMGOALIE$πNAME1$ = BELGIUMNAME1$: NAME2$ = BELGIUMNAME2$πGOALIE$ = BELGIUMGOALIE$πRETURNπBRAZIL:                                                  πSTEAL = 99: SPEED = 20: HANDS = 75πCLS : LOCATE 1, 37: PRINT "Brazil"πFOR T = 15 TO 175: LINE (0, T)-(640, T), 2: NEXT TπLINE (320, 35)-(600, 95), 14πLINE (600, 95)-(320, 155), 14πLINE (320, 155)-(40, 95), 14πLINE (40, 95)-(320, 35), 14: PAINT (320, 95), 14πCIRCLE (320, 95), 70, 9: PAINT (320, 95), 9πLOCATE 15, 25: PRINT "Player 1: "; BRAZILNAME1$πLOCATE 17, 25: PRINT "Player 2: "; BRAZILNAME2$πLOCATE 19, 27: PRINT "Goalie: "; BRAZILGOALIE$πNAME1$ = BRAZILNAME1$: NAME2$ = BRAZILNAME2$πGOALIE$ = BRAZILGOALIE$πRETURNπMOROCCO:                                                 πSTEAL = 20: SPEED = 3: HANDS = 26πCLS : LOCATE 1, 34: PRINT "Morocco"πFOR T = 15 TO 175: LINE (0, T)-(640, T), 4: NEXT TπLOCATE 15, 25: PRINT "Player 1: "; MOROCCONAME1$πLOCATE 17, 25: PRINT "Player 2: "; MOROCCONAME2$πLOCATE 19, 27: PRINT "Goalie: "; MOROCCOGOALIE$πNAME1$ = MOROCCONAME1$: NAME2$ = MOROCCONAME2$πππGOALIE$ = MOROCCOGOALIE$πRETURNπSOUTHKOREA:                                              πSTEAL = 18: SPEED = 4: HANDS = 27πCLS : LOCATE 1, 34: PRINT "South Korea"πFOR T = 15 TO 175: LINE (0, T)-(640, T), 15: NEXT TπCIRCLE (320, 95), 60, 0: CIRCLE (290, 95), 30, 4πCIRCLE (350, 95), 30, 1: PAINT (350, 95), 1πCIRCLE (290, 95), 30, 4: PAINT (290, 95), 4πCIRCLE (290, 95), 30, 0: CIRCLE (350, 95), 30, 0πPAINT (320, 65), 4, 0: PAINT (350, 125), 1, 0πCIRCLE (290, 95), 30, 4: CIRCLE (350, 95), 30, 1πLOCATE 15, 25: PRINT "Player 1: "; SOUTHKOREANAME1$πLOCATE 17, 25: PRINT "Player 2: "; SOUTHKOREANAME2$πLOCATE 19, 27: PRINT "Goalie: "; SOUTHKOREAGOALIE$πNAME1$ = SOUTHKOREANAME1$: NAME2$ = SOUTHKOREANAME2$πGOALIE$ = SOUTHKOREAGOALIE$πRETURNπSWEDEN:                                                  πSTEAL = 68: SPEED = 13: HANDS = 59πCLS : LOCATE 1, 36: PRINT "Sweden"πFOR T = 15 TO 175: LINE (0, T)-(640, T), 9: NEXT TπFOR T = 90 TO 110: LINE (T, 15)-(T, 175), 14: NEXT TπFOR T = 85 TO 105: LINE (0, T)-(640, T), 14: NEXT TπLOCATE 15, 25: PRINT "Player 1: "; SWEDENNAME1$πLOCATE 17, 25: PRINT "Player 2: "; SWEDENNAME2$πLOCATE 19, 27: PRINT "Goalie: "; SWEDENGOALIE$πNAME1$ = SWEDENNAME1$: NAME2$ = SWEDENNAME2$πGOALIE$ = SWEDENGOALIE$πRETURNπNORWAY:                                                  πSTEAL = 74: SPEED = 11: HANDS = 53πCLS : LOCATE 1, 35: PRINT "Norway"πFOR T = 15 TO 175: LINE (0, T)-(640, T), 4: NEXT TπLINE (0, 84)-(640, 84), 15: LINE (0, 106)-(640, 106), 15πLINE (209, 15)-(209, 175), 15πLINE (231, 15)-(231, 175), 15πFOR T = 210 TO 230: LINE (T, 15)-(T, 175), 1: NEXT TπFOR T = 85 TO 105: LINE (0, T)-(640, T), 1: NEXT TπLOCATE 15, 25: PRINT "Player 1: "; NORWAYNAME1$πLOCATE 17, 25: PRINT "Player 2: "; NORWAYNAME2$πLOCATE 19, 27: PRINT "Goalie: "; NORWAYGOALIE$πNAME1$ = NORWAYNAME1$: NAME2$ = NORWAYNAME2$πGOALIE$ = NORWAYGOALIE$πRETURNπSWITZERLAND:                                             πSTEAL = 62: SPEED = 14: HANDS = 59πCLS : LOCATE 1, 34: PRINT "Switzerland"πFOR T = 190 TO 450: LINE (T, 15)-(T, 175), 4: NEXT TπFOR T = 300 TO 340: LINE (T, 35)-(T, 155), 15: NEXT TπFOR T = 80 TO 110: LINE (210, T)-(430, T), 15: NEXT TπLOCATE 15, 25: PRINT "Player 1: "; SWITZERLANDNAME1$πLOCATE 17, 25: PRINT "Player 2: "; SWITZERLANDNAME2$πLOCATE 19, 27: PRINT "Goalie: "; SWITZERLANDGOALIE$πππNAME1$ = SWITZERLANDNAME1$: NAME2$ = SWITZERLANDNAME2$πGOALIE$ = SWITZERLANDGOALIE$πRETURNπFLASHER:                                                 πCLS : LET KO = INT(RND(1) * 15) + 1πPAINT (320, 175), KOπRETURNπINTRO:                                                   πINTROER = 1: CLS : SCREEN 9, , 0, 0: PCOPY 0, 1πBALLY = -220: FOR BALLX = -700 TO 800 STEP 50πSCREEN 9, , 0, 1: GOSUB SOCCERFIELDπLOCATE 12, 32: PRINT "By Alex Makris": SCREEN 9, , 0, 0πPCOPY 0, 1: NEXT BALLXπFOR BALLY = -220 TO -20 STEP 12.5: SCREEN 9, , 0, 1πGOSUB SOCCERFIELD: LOCATE 12, 32: PRINT "By Alex Makris"πSCREEN 9, , 0, 0: PCOPY 0, 1: NEXT BALLYπFOR BALLX = 800 TO -700 STEP -50: SCREEN 9, , 0, 1πGOSUB SOCCERFIELD: SCREEN 9, , 0, 0: PCOPY 0, 1πFOR T = 1 TO 200: NEXT T: NEXT BALLXπFOR BALLY = -20 TO 180 STEP 12.5: SCREEN 9, , 0, 1πGOSUB SOCCERFIELD: SCREEN 9, , 0, 0: PCOPY 0, 1πNEXT BALLY: FOR BALLX = -700 TO 800 STEP 50πSCREEN 9, , 0, 1: GOSUB SOCCERFIELDπLOCATE 12, 30: PRINT "World Cup Soccer 94"πSCREEN 9, , 0, 0: PCOPY 0, 1: NEXT BALLXπFOR BALLY = 180 TO 380 STEP 12.5: SCREEN 9, , 0, 1πGOSUB SOCCERFIELDπLOCATE 12, 30: PRINT "World Cup Soccer 94"πSCREEN 9, , 0, 0: PCOPY 0, 1: NEXT BALLYπFOR BALLX = 800 TO -900 STEP -50: SCREEN 9, , 0, 1πGOSUB SOCCERFIELD: SCREEN 9, , 0, 0: PCOPY 0, 1πNEXT BALLX: INTROER = 0πRETURNπLOGO:                                                    πLINE (X, Y)-(X + 40, Y), 0πLINE (X + 40, Y)-(X + 40, Y + 30), 0πLINE (X + 40, Y + 30)-(X + 20, Y + 30), 0πLINE (X + 20, Y + 30)-(X + 20, Y + 70), 0πLINE (X + 20, Y + 70)-(X + 40, Y + 70), 0πLINE (X + 40, Y + 70)-(X + 40, Y + 150), 0πLINE (X + 40, Y + 150)-(X, Y + 180), 0πLINE (X, Y + 180)-(X, Y + 140), 0πLINE (X, Y + 140)-(X + 20, Y + 130), 0πLINE (X + 20, Y + 130)-(X + 20, Y + 100), 0πLINE (X + 20, Y + 100)-(X, Y + 100), 0πLINE (X, Y + 100)-(X, Y), 0πLINE (X + 50, Y)-(X + 95, Y), 0πLINE (X + 95, Y)-(X + 95, Y + 110), 0πLINE (X + 95, Y + 110)-(X + 50, Y + 140), 0πLINE (X + 50, Y + 140)-(X + 50, Y), 0πLINE (X + 65, Y + 20)-(X + 80, Y + 20), 0πLINE (X + 80, Y + 20)-(X + 80, Y + 105), 0πLINE (X + 80, Y + 105)-(X + 65, Y + 114), 0πLINE (X + 65, Y + 114)-(X + 65, Y + 20), 0πππLINE (X + 105, Y)-(X + 135, Y), 0πLINE (X + 135, Y)-(X + 135, Y + 20), 0πLINE (X + 135, Y + 20)-(X + 120, Y + 20), 0πLINE (X + 120, Y + 20)-(X + 120, Y + 85), 0πLINE (X + 120, Y + 85)-(X + 135, Y + 75), 0πLINE (X + 135, Y + 75)-(X + 135, Y + 92), 0πLINE (X + 135, Y + 92)-(X + 105, Y + 107), 0πLINE (X + 105, Y + 107)-(X + 105, Y), 0πLINE (X + 145, Y)-(X + 180, Y), 0πLINE (X + 180, Y)-(X + 180, Y + 20), 0πLINE (X + 180, Y + 20)-(X + 160, Y + 20), 0πLINE (X + 160, Y + 20)-(X + 160, Y + 75), 0πLINE (X + 160, Y + 75)-(X + 180, Y + 65), 0πLINE (X + 180, Y + 65)-(X + 180, Y + 80), 0πLINE (X + 180, Y + 80)-(X + 145, Y + 90), 0πLINE (X + 145, Y + 90)-(X + 145, Y), 0πLINE (X + 190, Y)-(X + 220, Y), 0πLINE (X + 220, Y)-(X + 220, Y + 20), 0πLINE (X + 220, Y + 20)-(X + 205, Y + 20), 0πLINE (X + 205, Y + 20)-(X + 205, Y + 30), 0πLINE (X + 205, Y + 30)-(X + 220, Y + 30), 0πLINE (X + 220, Y + 30)-(X + 220, Y + 40), 0πLINE (X + 220, Y + 40)-(X + 205, Y + 40), 0πLINE (X + 205, Y + 40)-(X + 205, Y + 65), 0πLINE (X + 205, Y + 65)-(X + 220, Y + 60), 0πLINE (X + 220, Y + 60)-(X + 220, Y + 70), 0πLINE (X + 220, Y + 70)-(X + 190, Y + 78), 0πLINE (X + 190, Y + 78)-(X + 190, Y), 0πLINE (X + 230, Y)-(X + 270, Y), 0πLINE (X + 270, Y)-(X + 270, Y + 40), 0πLINE (X + 270, Y + 40)-(X + 265, Y + 43), 0πLINE (X + 265, Y + 43)-(X + 270, Y + 65), 0πLINE (X + 270, Y + 65)-(X + 255, Y + 66), 0πLINE (X + 255, Y + 66)-(X + 250, Y + 40), 0πLINE (X + 250, Y + 40)-(X + 245, Y + 40), 0πLINE (X + 245, Y + 40)-(X + 244, Y + 66), 0πLINE (X + 244, Y + 66)-(X + 230, Y + 68), 0πLINE (X + 230, Y + 68)-(X + 230, Y), 0πLINE (X + 245, Y + 15)-(X + 255, Y + 15), 0πLINE (X + 255, Y + 15)-(X + 255, Y + 31), 0πLINE (X + 255, Y + 31)-(X + 245, Y + 32), 0πLINE (X + 245, Y + 32)-(X + 245, Y + 15), 0πRETURNπLOGOCOVER:                                               πLINE (X, Y)-(X + 40, Y), COVERπLINE (X + 40, Y)-(X + 40, Y + 30), COVERπLINE (X + 40, Y + 30)-(X + 20, Y + 30), COVERπLINE (X + 20, Y + 30)-(X + 20, Y + 70), COVERπLINE (X + 20, Y + 70)-(X + 40, Y + 70), COVERπLINE (X + 40, Y + 70)-(X + 40, Y + 150), COVERπLINE (X + 40, Y + 150)-(X, Y + 180), COVERπLINE (X, Y + 180)-(X, Y + 140), COVERπLINE (X, Y + 140)-(X + 20, Y + 130), COVERπLINE (X + 20, Y + 130)-(X + 20, Y + 100), COVERπππLINE (X + 20, Y + 100)-(X, Y + 100), COVERπLINE (X, Y + 100)-(X, Y), COVERπLINE (X + 50, Y)-(X + 95, Y), COVERπLINE (X + 95, Y)-(X + 95, Y + 110), COVERπLINE (X + 95, Y + 110)-(X + 50, Y + 140), COVERπLINE (X + 50, Y + 140)-(X + 50, Y), COVERπLINE (X + 65, Y + 20)-(X + 80, Y + 20), COVERπLINE (X + 80, Y + 20)-(X + 80, Y + 105), COVERπLINE (X + 80, Y + 105)-(X + 65, Y + 114), COVERπLINE (X + 65, Y + 114)-(X + 65, Y + 20), COVERπLINE (X + 105, Y)-(X + 135, Y), COVERπLINE (X + 135, Y)-(X + 135, Y + 20), COVERπLINE (X + 135, Y + 20)-(X + 120, Y + 20), COVERπLINE (X + 120, Y + 20)-(X + 120, Y + 85), COVERπLINE (X + 120, Y + 85)-(X + 135, Y + 75), COVERπLINE (X + 135, Y + 75)-(X + 135, Y + 92), COVERπLINE (X + 135, Y + 92)-(X + 105, Y + 107), COVERπLINE (X + 105, Y + 107)-(X + 105, Y), COVERπLINE (X + 145, Y)-(X + 180, Y), COVERπLINE (X + 180, Y)-(X + 180, Y + 20), COVERπLINE (X + 180, Y + 20)-(X + 160, Y + 20), COVERπLINE (X + 160, Y + 20)-(X + 160, Y + 75), COVERπLINE (X + 160, Y + 75)-(X + 180, Y + 65), COVERπLINE (X + 180, Y + 65)-(X + 180, Y + 80), COVERπLINE (X + 180, Y + 80)-(X + 145, Y + 90), COVERπLINE (X + 145, Y + 90)-(X + 145, Y), COVERπLINE (X + 190, Y)-(X + 220, Y), COVERπLINE (X + 220, Y)-(X + 220, Y + 20), COVERπLINE (X + 220, Y + 20)-(X + 205, Y + 20), COVERπLINE (X + 205, Y + 20)-(X + 205, Y + 30), COVERπLINE (X + 205, Y + 30)-(X + 220, Y + 30), COVERπLINE (X + 220, Y + 30)-(X + 220, Y + 40), COVERπLINE (X + 220, Y + 40)-(X + 205, Y + 40), COVERπLINE (X + 205, Y + 40)-(X + 205, Y + 65), COVERπLINE (X + 205, Y + 65)-(X + 220, Y + 60), COVERπLINE (X + 220, Y + 60)-(X + 220, Y + 70), COVERπLINE (X + 220, Y + 70)-(X + 190, Y + 78), COVERπLINE (X + 190, Y + 78)-(X + 190, Y), COVERπLINE (X + 230, Y)-(X + 270, Y), COVERπLINE (X + 270, Y)-(X + 270, Y + 40), COVERπLINE (X + 270, Y + 40)-(X + 265, Y + 43), COVERπLINE (X + 265, Y + 43)-(X + 270, Y + 65), COVERπLINE (X + 270, Y + 65)-(X + 255, Y + 66), COVERπLINE (X + 255, Y + 66)-(X + 250, Y + 40), COVERπLINE (X + 250, Y + 40)-(X + 245, Y + 40), COVERπLINE (X + 245, Y + 40)-(X + 244, Y + 66), COVERπLINE (X + 244, Y + 66)-(X + 230, Y + 68), COVERπLINE (X + 230, Y + 68)-(X + 230, Y), COVERπLINE (X + 245, Y + 15)-(X + 255, Y + 15), COVERπLINE (X + 255, Y + 15)-(X + 255, Y + 31), COVERπLINE (X + 255, Y + 31)-(X + 245, Y + 32), COVERπLINE (X + 245, Y + 32)-(X + 245, Y + 15), COVERπRETURNπMENU:                                                    πππ10000 CLS : PAINT (320, 175), 2: Y = 42πFOR X = -250 TO 190 STEP 20: GOSUB LOGOπGOSUB LOGOFLASH: COVER = 2πSCREEN 9, , 0, 0: PCOPY 0, 1πIF X <> 190 THEN GOSUB LOGOCOVER: GOSUB LOGOLETTERCOVERπPLAY "O2 L64 G": NEXT X: PLAY "O0 L10 C"πFOR T = 1 TO 10000: NEXT T: PLAY "O4 L64 CBAGFED"πLOCATE 4, 22: PRINT "W": LOCATE 5, 22: PRINT "o"πLOCATE 6, 22: PRINT "r": LOCATE 7, 22: PRINT "l"πLOCATE 8, 22: PRINT "d": LOCATE 10, 22πPRINT "C": LOCATE 11, 22: PRINT "u": LOCATE 12, 22πPRINT "p": LOCATE 14, 22: PRINT "9": LOCATE 15, 22πPRINT "4": FOR T = 1 TO 10000: NEXT TπFOR T = 3000 TO 100 STEP -1000: SOUND T, 1: NEXT TπLOCATE 16, 35: PRINT "Main Menu"πLOCATE 18, 26: PRINT "1) Instructions            "πLOCATE 19, 26: PRINT "2) Print operation controls"πLOCATE 20, 26: PRINT "3) Start playing           "πLOCATE 21, 26: PRINT "4) Quit                    "πX = 450: Y = 100: GOSUB STRIKERπPRINT "Enter choice:"πA$ = " "π10001 A$ = INKEY$πIF A$ <> "1" AND A$ <> "2" AND A$ <> "3" AND A$ <> "4" THEN GOTO 10001πIF A$ = "1" THEN GOSUB INSTRUCTIONS: GOTO 10000πIF A$ = "2" THEN GOSUB CONTROLS: GOTO 10000πIF A$ = "4" THEN ENDπIF A$ <> "3" THEN GOTO 10000πRETURNπLOGOFLASH:                                               πLET H = INT(RND(1) * 14) + 1: IF X = 190 THEN H = 14πPAINT (X + 10, Y + 3), H, 0: PAINT (X + 60, Y + 3), H, 0πPAINT (X + 110, Y + 3), H, 0: PAINT (X + 155, Y + 3), H, 0πPAINT (X + 200, Y + 3), H, 0: PAINT (X + 240, Y + 3), H, 0πRETURNπLOGOLETTERCOVER:                                         πPAINT (X + 10, Y + 3), COVER, 0πPAINT (X + 60, Y + 3), COVER, 0πPAINT (X + 110, Y + 3), COVER, 0πPAINT (X + 155, Y + 3), COVER, 0πPAINT (X + 200, Y + 3), COVER, 0πPAINT (X + 240, Y + 3), COVER, 0πRETURNπSTRIKER:                                                 πLINE (X + 27, Y + 41)-(X + 35, Y + 49), 0πLINE (X + 35, Y + 49)-(X + 29, Y + 48), 0πLINE (X + 29, Y + 48)-(X + 25, Y + 50), 0πLINE (X + 25, Y + 50)-(X + 27, Y + 41), 0πPAINT (X + 29, Y + 46), 0, 0πLINE (X, Y + 100)-(X + 5, Y + 95), 0πLINE (X + 5, Y + 95)-(X + 20, Y + 90), 0πLINE (X + 20, Y + 90)-(X + 30, Y + 100), 0πLINE (X + 30, Y + 100)-(X + 25, Y + 110), 0πLINE (X + 25, Y + 110)-(X + 20, Y + 115), 0πππLINE (X + 20, Y + 115)-(X + 10, Y + 110), 0πLINE (X + 10, Y + 110)-(X, Y + 100), 0πPAINT (X + 15, Y + 100), 0, 0πLINE (X + 25, Y + 61)-(X + 31, Y + 54), 0πLINE (X + 31, Y + 54)-(X + 36, Y + 58), 0πLINE (X + 36, Y + 58)-(X + 37, Y + 64), 0πLINE (X + 37, Y + 64)-(X + 35, Y + 70), 0πLINE (X + 35, Y + 70)-(X + 28, Y + 69), 0πLINE (X + 28, Y + 69)-(X + 25, Y + 61), 0πPAINT (X + 32, Y + 62), 15, 0πLINE (X + 25, Y + 61)-(X + 32, Y + 60), 0πLINE (X + 32, Y + 60)-(X + 35, Y + 70), 0πPAINT (X + 30, Y + 63), 0, 0πLINE (X + 5, Y + 95)-(X + 20, Y + 65), 0πLINE (X + 20, Y + 65)-(X + 30, Y + 50), 0πLINE (X + 30, Y + 50)-(X + 38, Y + 45), 0πLINE (X + 38, Y + 45)-(X + 47, Y + 55), 0πLINE (X + 47, Y + 55)-(X + 52, Y + 70), 0πLINE (X + 52, Y + 70)-(X + 50, Y + 80), 0πLINE (X + 50, Y + 80)-(X + 45, Y + 90), 0πLINE (X + 45, Y + 90)-(X + 45, Y + 100), 0πLINE (X + 45, Y + 100)-(X + 40, Y + 112), 0πLINE (X + 40, Y + 112)-(X + 30, Y + 118), 0πLINE (X + 30, Y + 118)-(X + 20, Y + 115), 0πPAINT (X + 30, Y + 80), 6, 0πLINE (X + 45, Y + 90)-(X + 38, Y + 79), 0πLINE (X + 38, Y + 79)-(X + 43, Y + 80), 0πLINE (X + 38, Y + 79)-(X + 34, Y + 81), 0πLINE (X + 25, Y + 20)-(X + 32, Y + 6), 0πLINE (X + 32, Y + 6)-(X + 37, Y + 7), 0πLINE (X + 37, Y + 7)-(X + 32, Y + 20), 0πLINE (X + 32, Y + 20)-(X + 33, Y + 38), 0πLINE (X + 33, Y + 38)-(X + 26, Y + 31), 0πLINE (X + 26, Y + 31)-(X + 25, Y + 20), 0πPAINT (X + 29, Y + 20), 0, 0πLINE (X + 41, Y + 44)-(X + 55, Y + 29), 0πLINE (X + 55, Y + 29)-(X + 65, Y + 31), 0πLINE (X + 65, Y + 31)-(X + 74, Y + 44), 0πLINE (X + 74, Y + 44)-(X + 55, Y + 40), 0πLINE (X + 55, Y + 40)-(X + 41, Y + 44), 0πPAINT (X + 57, Y + 33), 0, 0πLINE (X + 50, Y + 80)-(X + 60, Y + 90), 0πLINE (X + 60, Y + 90)-(X + 59, Y + 95), 0πLINE (X + 59, Y + 95)-(X + 60, Y + 100), 0πLINE (X + 60, Y + 100)-(X + 45, Y + 90), 0πPAINT (X + 55, Y + 90), 6, 0πLINE (X + 60, Y + 90)-(X + 79, Y + 82), 0πLINE (X + 79, Y + 82)-(X + 81, Y + 89), 0πLINE (X + 81, Y + 89)-(X + 76, Y + 90), 0πLINE (X + 76, Y + 90)-(X + 72, Y + 90), 0πLINE (X + 72, Y + 90)-(X + 71, Y + 100), 0πLINE (X + 71, Y + 100)-(X + 75, Y + 105), 0πLINE (X + 75, Y + 105)-(X + 77, Y + 100), 0πLINE (X + 77, Y + 100)-(X + 80, Y + 106), 0πππLINE (X + 80, Y + 106)-(X + 75, Y + 110), 0πLINE (X + 75, Y + 110)-(X + 65, Y + 105), 0πLINE (X + 65, Y + 105)-(X + 66, Y + 96), 0πLINE (X + 66, Y + 96)-(X + 64, Y + 97), 0πLINE (X + 64, Y + 97)-(X + 62, Y + 106), 0πLINE (X + 62, Y + 106)-(X + 60, Y + 107), 0πLINE (X + 60, Y + 107)-(X + 60, Y + 100), 0πPAINT (X + 67, Y + 97), 4, 0πLINE (X + 60, Y + 107)-(X + 61, Y + 120), 0πLINE (X + 61, Y + 120)-(X + 70, Y + 130), 0πLINE (X + 70, Y + 130)-(X + 75, Y + 129), 0πLINE (X + 75, Y + 129)-(X + 80, Y + 120), 0πLINE (X + 80, Y + 120)-(X + 83, Y + 113), 0πLINE (X + 83, Y + 113)-(X + 80, Y + 106), 0πPAINT (X + 70, Y + 115), 15, 0πLINE (X + 83, Y + 113)-(X + 87, Y + 119), 0πLINE (X + 87, Y + 119)-(X + 85, Y + 122), 0πLINE (X + 85, Y + 122)-(X + 90, Y + 125), 0πLINE (X + 90, Y + 125)-(X + 99, Y + 121), 0πLINE (X + 99, Y + 121)-(X + 101, Y + 141), 0πLINE (X + 101, Y + 141)-(X + 92, Y + 151), 0πLINE (X + 92, Y + 151)-(X + 71, Y + 148), 0πLINE (X + 71, Y + 148)-(X + 46, Y + 152), 0πLINE (X + 46, Y + 152)-(X + 50, Y + 139), 0πLINE (X + 50, Y + 139)-(X + 48, Y + 130), 0πLINE (X + 48, Y + 130)-(X + 40, Y + 121), 0πLINE (X + 40, Y + 121)-(X + 51, Y + 122), 0πLINE (X + 51, Y + 122)-(X + 61, Y + 120), 0πPAINT (X + 70, Y + 137), 1, 0πLINE (X + 48, Y + 130)-(X + 36, Y + 138), 0πLINE (X + 36, Y + 138)-(X + 37, Y + 126), 0πLINE (X + 37, Y + 126)-(X + 40, Y + 121), 0πPAINT (X + 42, Y + 130), 0, 0πLINE (X + 36, Y + 138)-(X + 30, Y + 141), 0πLINE (X + 30, Y + 141)-(X + 35, Y + 150), 0πLINE (X + 35, Y + 150)-(X + 47, Y + 147), 0πPAINT (X + 40, Y + 140), 6, 0πLINE (X + 35, Y + 150)-(X + 30, Y + 152), 0πLINE (X + 30, Y + 152)-(X + 25, Y + 144), 0πLINE (X + 25, Y + 144)-(X + 30, Y + 141), 0πPAINT (X + 31, Y + 146), 15, 0πLINE (X + 30, Y + 152)-(X + 25, Y + 154), 0πLINE (X + 25, Y + 154)-(X + 20, Y + 145), 0πLINE (X + 20, Y + 145)-(X + 25, Y + 144), 0πPAINT (X + 22, Y + 145), 4, 0πLINE (X + 25, Y + 154)-(X + 20, Y + 155), 0πLINE (X + 20, Y + 155)-(X + 15, Y + 147), 0πLINE (X + 15, Y + 147)-(X + 20, Y + 145), 0πPAINT (X + 16, Y + 147), 15, 0πLINE (X + 20, Y + 155)-(X + 16, Y + 162), 0πLINE (X + 16, Y + 162)-(X + 7, Y + 164), 0πLINE (X + 7, Y + 164)-(X + 4, Y + 150), 0πLINE (X + 4, Y + 150)-(X + 4, Y + 140), 0πLINE (X + 4, Y + 140)-(X + 14, Y + 126), 0πππLINE (X + 14, Y + 126)-(X + 27, Y + 130), 0πLINE (X + 27, Y + 130)-(X + 27, Y + 135), 0πLINE (X + 27, Y + 135)-(X + 15, Y + 147), 0πPAINT (X + 10, Y + 150), 0, 0πLINE (X + 101, Y + 141)-(X + 108, Y + 160), 0πLINE (X + 108, Y + 160)-(X + 104, Y + 164), 0πLINE (X + 104, Y + 164)-(X + 90, Y + 160), 0πLINE (X + 90, Y + 160)-(X + 85, Y + 153), 0πLINE (X + 85, Y + 153)-(X + 92, Y + 154), 0πLINE (X + 92, Y + 154)-(X + 92, Y + 151), 0πPAINT (X + 100, Y + 155), 6, 0πLINE (X + 85, Y + 153)-(X + 79, Y + 154), 0πLINE (X + 79, Y + 154)-(X + 90, Y + 160), 0πPAINT (X + 85, Y + 155), 15, 0πLINE (X + 90, Y + 160)-(X + 95, Y + 169), 0πLINE (X + 95, Y + 169)-(X + 99, Y + 180), 0πLINE (X + 99, Y + 180)-(X + 96, Y + 190), 0πLINE (X + 96, Y + 190)-(X + 85, Y + 190), 0πLINE (X + 85, Y + 190)-(X + 79, Y + 179), 0πLINE (X + 79, Y + 179)-(X + 72, Y + 160), 0πLINE (X + 72, Y + 160)-(X + 76, Y + 151), 0πLINE (X + 76, Y + 151)-(X + 80, Y + 155), 0πPAINT (X + 85, Y + 170), 0, 0πLINE (X + 72, Y + 90)-(X + 90, Y + 88), 0πLINE (X + 90, Y + 88)-(X + 85, Y + 75), 0πLINE (X + 85, Y + 75)-(X + 90, Y + 71), 0πLINE (X + 90, Y + 71)-(X + 92, Y + 72), 0πLINE (X + 92, Y + 72)-(X + 96, Y + 65), 0πLINE (X + 96, Y + 65)-(X + 100, Y + 61), 0πLINE (X + 100, Y + 61)-(X + 106, Y + 69), 0πLINE (X + 106, Y + 69)-(X + 115, Y + 75), 0πLINE (X + 115, Y + 75)-(X + 113, Y + 83), 0πLINE (X + 113, Y + 83)-(X + 108, Y + 86), 0πLINE (X + 108, Y + 86)-(X + 106, Y + 93), 0πLINE (X + 106, Y + 93)-(X + 101, Y + 92), 0πLINE (X + 101, Y + 92)-(X + 99, Y + 96), 0πLINE (X + 99, Y + 96)-(X + 95, Y + 96), 0πLINE (X + 95, Y + 96)-(X + 92, Y + 92), 0πLINE (X + 92, Y + 92)-(X + 77, Y + 100), 0πPAINT (X + 100, Y + 80), 6, 0πLINE (X + 92, Y + 72)-(X + 97, Y + 78), 0πLINE (X + 97, Y + 78)-(X + 95, Y + 81), 0πLINE (X + 95, Y + 81)-(X + 90, Y + 79), 0πLINE (X + 105, Y + 70)-(X + 97, Y + 75), 0πLINE (X + 107, Y + 85)-(X + 101, Y + 84), 0πLINE (X + 101, Y + 84)-(X + 98, Y + 80), 0πLINE (X + 101, Y + 84)-(X + 97, Y + 86), 0πLINE (X + 97, Y + 86)-(X + 97, Y + 91), 0πLINE (X + 97, Y + 91)-(X + 100, Y + 92), 0πLINE (X + 68, Y + 87)-(X + 62, Y + 73), 0πLINE (X + 62, Y + 73)-(X + 67, Y + 71), 0πLINE (X + 67, Y + 71)-(X + 67, Y + 67), 0πLINE (X + 67, Y + 67)-(X + 61, Y + 60), 0πLINE (X + 61, Y + 60)-(X + 58, Y + 55), 0πππLINE (X + 58, Y + 55)-(X + 55, Y + 58), 0πLINE (X + 55, Y + 58)-(X + 56, Y + 61), 0πLINE (X + 56, Y + 61)-(X + 52, Y + 62), 0πLINE (X + 52, Y + 62)-(X + 58, Y + 71), 0πLINE (X + 58, Y + 71)-(X + 57, Y + 86), 0πPAINT (X + 62, Y + 80), 6, 0πRETURNπSOCCERFIELD:                                             πCLSπIF INTROER = 0 THENπ CIRCLE (320, 175), 5, 15: PAINT (320, 175), 15, 15πEND IFπFOR U = -20 TO 580 STEP 200πLINE (-200 - BALLX, U - BALLY)-(1000 - BALLX, U - BALLY), 2πNEXT UπFOR U = -200 TO 1000 STEP 300πLINE (U - BALLX, -20 - BALLY)-(U - BALLX, 580 - BALLY), 2πNEXT UπLINE (-200 - BALLX, -20 - BALLY)-(-200 - BALLX, -40 - BALLY), 15πLINE (-200 - BALLX, -40 - BALLY)-(-185 - BALLX, -40 - BALLY), 4πLINE (-185 - BALLX, -40 - BALLY)-(-200 - BALLX, -60 - BALLY), 4πLINE (-200 - BALLX, -60 - BALLY)-(-200 - BALLX, -40 - BALLY), 4πPAINT (-195 - BALLX, -45 - BALLY), 4, 4πLINE (1000 - BALLX, -20 - BALLY)-(1000 - BALLX, -40 - BALLY), 15πLINE (1000 - BALLX, -40 - BALLY)-(1015 - BALLX, -40 - BALLY), 4πLINE (1015 - BALLX, -40 - BALLY)-(1000 - BALLX, -60 - BALLY), 4πLINE (1000 - BALLX, -60 - BALLY)-(1000 - BALLX, -40 - BALLY), 4πPAINT (1005 - BALLX, -45 - BALLY), 4, 4πLINE (-200 - BALLX, 580 - BALLY)-(-200 - BALLX, 560 - BALLY), 15πLINE (-200 - BALLX, 560 - BALLY)-(-185 - BALLX, 560 - BALLY), 4πLINE (-185 - BALLX, 560 - BALLY)-(-200 - BALLX, 540 - BALLY), 4πLINE (-200 - BALLX, 540 - BALLY)-(-200 - BALLX, 560 - BALLY), 4πPAINT (-195 - BALLX, 555 - BALLY), 4, 4πLINE (1000 - BALLX, 580 - BALLY)-(1000 - BALLX, 560 - BALLY), 15πLINE (1000 - BALLX, 560 - BALLY)-(1015 - BALLX, 560 - BALLY), 4πLINE (1015 - BALLX, 560 - BALLY)-(1000 - BALLX, 540 - BALLY), 4πLINE (1000 - BALLX, 540 - BALLY)-(1000 - BALLX, 560 - BALLY), 4πPAINT (1005 - BALLX, 555 - BALLY), 4, 4πLINE (398 - BALLX, -20 - BALLY)-(398 - BALLX, 580 - BALLY), 15πLINE (400 - BALLX, -20 - BALLY)-(400 - BALLX, 580 - BALLY), 15πLINE (402 - BALLX, -20 - BALLY)-(402 - BALLX, 580 - BALLY), 15πCIRCLE (400 - BALLX, 280 - BALLY), 100, 15πCIRCLE (400 - BALLX, 280 - BALLY), 103, 15πLINE (0 - BALLX, 80 - BALLY)-(0 - BALLX, 480 - BALLY), 15πLINE (-2 - BALLX, 80 - BALLY)-(-2 - BALLX, 480 - BALLY), 15πLINE (2 - BALLX, 80 - BALLY)-(2 - BALLX, 480 - BALLY), 15πLINE (800 - BALLX, 80 - BALLY)-(800 - BALLX, 480 - BALLY), 15πLINE (798 - BALLX, 80 - BALLY)-(798 - BALLX, 480 - BALLY), 15πLINE (802 - BALLX, 80 - BALLY)-(802 - BALLX, 480 - BALLY), 15πLINE (-200 - BALLX, 82 - BALLY)-(2 - BALLX, 82 - BALLY), 15πLINE (-200 - BALLX, 80 - BALLY)-(2 - BALLX, 80 - BALLY), 15πLINE (-200 - BALLX, 78 - BALLY)-(2 - BALLX, 78 - BALLY), 15πLINE (798 - BALLX, 82 - BALLY)-(1000 - BALLX, 82 - BALLY), 15πLINE (798 - BALLX, 80 - BALLY)-(1000 - BALLX, 80 - BALLY), 15πππLINE (798 - BALLX, 78 - BALLY)-(1000 - BALLX, 78 - BALLY), 15πLINE (-200 - BALLX, 482 - BALLY)-(2 - BALLX, 482 - BALLY), 15πLINE (-200 - BALLX, 480 - BALLY)-(2 - BALLX, 480 - BALLY), 15πLINE (-200 - BALLX, 478 - BALLY)-(2 - BALLX, 478 - BALLY), 15πLINE (798 - BALLX, 482 - BALLY)-(1000 - BALLX, 482 - BALLY), 15πLINE (798 - BALLX, 480 - BALLY)-(1000 - BALLX, 480 - BALLY), 15πLINE (798 - BALLX, 478 - BALLY)-(1000 - BALLX, 478 - BALLY), 15πFOR U = 1000 TO 1075 STEP 25πLINE (U - BALLX, 180 - BALLY + ((U - 1000) / 3) - 25)-(U - BALLX, 380 - BALLY + ((U - 1000) / 3) - 25), 14πNEXT U: FOR U = 155 TO 355 STEP 50πLINE (1000 - BALLX, U - BALLY)-(1075 - BALLX, U - BALLY + 25), 14πNEXT UπLINE (1000 - BALLX, 180 - BALLY)-(1075 - BALLX, 180 - BALLY), 14πLINE (1000 - BALLX, 380 - BALLY)-(1075 - BALLX, 380 - BALLY), 14πLINE (1000 - BALLX, 355 - BALLY)-(1000 - BALLX, 380 - BALLY), 14πFOR U = -200 TO -275 STEP -25πLINE (U - BALLX, 180 - BALLY - ((U - -200) / 3) - 25)-(U - BALLX, 380 - BALLY - ((U - -200) / 3) - 25), 14πNEXT U: FOR U = 155 TO 355 STEP 50πLINE (-200 - BALLX, U - BALLY)-(-275 - BALLX, U - BALLY + 25), 14πNEXT UπLINE (-200 - BALLX, 180 - BALLY)-(-275 - BALLX, 180 - BALLY), 14πLINE (-200 - BALLX, 380 - BALLY)-(-275 - BALLX, 380 - BALLY), 14πLINE (-200 - BALLX, 355 - BALLY)-(-200 - BALLX, 380 - BALLY), 14πIF INTROER = 0 THEN PUT (305, 1), MINI%, PSETπCIRCLE (((FIELDER11X + 200) / 40) + 305, ((FIELDER11Y + 20) / 40) + 1), 2, SHIRT1πCIRCLE (((FIELDER12X + 200) / 40) + 305, ((FIELDER12Y + 20) / 40) + 1), 2, SHIRT1πCIRCLE (((FIELDER21X + 200) / 40) + 305, ((FIELDER21Y + 20) / 40) + 1), 2, SHIRT2πCIRCLE (((FIELDER22X + 200) / 40) + 305, ((FIELDER22Y + 20) / 40) + 1), 2, SHIRT2πCIRCLE (((-280 + 200) / 40) + 305, ((GOALY1 + 20) / 40) + 1), 2, SHIRT1πCIRCLE (((1000 + 200) / 40) + 305, ((GOALY2 + 20) / 40) + 1), 2, SHIRT2πRETURNπPLAYER:                                                  πLINE (X - 10 - BALLX, Y - 69 - BALLY)-(X + 15 - BALLX, Y - 67 - BALLY), 8πLINE (X + 15 - BALLX, Y - 67 - BALLY)-(X + 20 - BALLX, Y - 58 - BALLY), 8πLINE (X + 20 - BALLX, Y - 58 - BALLY)-(X + 25 - BALLX, Y - 55 - BALLY), 8πLINE (X + 25 - BALLX, Y - 55 - BALLY)-(X + 25 - BALLX, Y - 50 - BALLY), 8πLINE (X + 25 - BALLX, Y - 50 - BALLY)-(X + 20 - BALLX, Y - 51 - BALLY), 8πLINE (X + 20 - BALLX, Y - 51 - BALLY)-(X + 18 - BALLX, Y - 42 - BALLY), 8πLINE (X + 18 - BALLX, Y - 42 - BALLY)-(X + 11 - BALLX, Y - 39 - BALLY), 8πLINE (X + 11 - BALLX, Y - 39 - BALLY)-(X - BALLX, Y - 38 - BALLY), 8πLINE (X - BALLX, Y - 38 - BALLY)-(X - 9 - BALLX, Y - 41 - BALLY), 8πLINE (X - 9 - BALLX, Y - 41 - BALLY)-(X - 14 - BALLX, Y - 44 - BALLY), 8πLINE (X - 14 - BALLX, Y - 44 - BALLY)-(X - 18 - BALLX, Y - 50 - BALLY), 8πLINE (X - 18 - BALLX, Y - 50 - BALLY)-(X - 19 - BALLX, Y - 61 - BALLY), 8πLINE (X - 19 - BALLX, Y - 61 - BALLY)-(X - 14 - BALLX, Y - 65 - BALLY), 8πLINE (X - 14 - BALLX, Y - 65 - BALLY)-(X - 10 - BALLX, Y - 69 - BALLY), 8πLINE (X - 12 - BALLX, Y - 40 - BALLY)-(X - 10 - BALLX, Y - 39 - BALLY), 8πPAINT (X - BALLX, Y - 55 - BALLY), 12, 8πLINE (X + 13 - BALLX, Y - 50 - BALLY)-(X + 7 - BALLX, Y - 44 - BALLY), 8πππLINE (X + 7 - BALLX, Y - 44 - BALLY)-(X - 4 - BALLX, Y - 44 - BALLY), 8πLINE (X - 4 - BALLX, Y - 44 - BALLY)-(X - 10 - BALLX, Y - 50 - BALLY), 8πLINE (X - BALLX, Y - 51 - BALLY)-(X - 10 - BALLX, Y - 52 - BALLY), 8πLINE (X - 10 - BALLX, Y - 52 - BALLY)-(X - 15 - BALLX, Y - 59 - BALLY), 8πLINE (X - 15 - BALLX, Y - 59 - BALLY)-(X - 9 - BALLX, Y - 57 - BALLY), 8πLINE (X - 9 - BALLX, Y - 57 - BALLY)-(X - BALLX, Y - 54 - BALLY), 8πLINE (X - BALLX, Y - 54 - BALLY)-(X + 3 - BALLX, Y - 63 - BALLY), 8πCIRCLE (X - 3 - BALLX, Y - 60 - BALLY), 3, 8πCIRCLE (X + 7 - BALLX, Y - 60 - BALLY), 3, 8πPAINT (X - 3 - BALLX, Y - 60 - BALLY), 1, 8πPAINT (X + 7 - BALLX, Y - 60 - BALLY), 1, 8πLINE (X + 15 - BALLX, Y - 67 - BALLY)-(X + 11 - BALLX, Y - 74 - BALLY), 8πLINE (X + 11 - BALLX, Y - 74 - BALLY)-(X + 2 - BALLX, Y - 81 - BALLY), 8πLINE (X + 2 - BALLX, Y - 81 - BALLY)-(X + 4 - BALLX, Y - 73 - BALLY), 8πLINE (X + 4 - BALLX, Y - 73 - BALLY)-(X - 6 - BALLX, Y - 80 - BALLY), 8πLINE (X - 6 - BALLX, Y - 80 - BALLY)-(X - 10 - BALLX, Y - 76 - BALLY), 8πLINE (X - 10 - BALLX, Y - 76 - BALLY)-(X - 2 - BALLX, Y - 71 - BALLY), 8πLINE (X - 2 - BALLX, Y - 71 - BALLY)-(X - 14 - BALLX, Y - 73 - BALLY), 8πLINE (X - 14 - BALLX, Y - 73 - BALLY)-(X - 15 - BALLX, Y - 70 - BALLY), 8πLINE (X - 15 - BALLX, Y - 70 - BALLY)-(X - 10 - BALLX, Y - 69 - BALLY), 8πPAINT (X - BALLX, Y - 70 - BALLY), 14, 8πLINE (X + 8 - BALLX, Y - 38 - BALLY)-(X + 10 - BALLX, Y - 20 - BALLY), 8πLINE (X + 10 - BALLX, Y - 20 - BALLY)-(X - 13 - BALLX, Y - 20 - BALLY), 8πLINE (X - 13 - BALLX, Y - 20 - BALLY)-(X - 9 - BALLX, Y - 39 - BALLY), 8πPAINT (X - BALLX, Y - 30 - BALLY), SHIRT, 8πLINE (X - 9 - BALLX, Y - 39 - BALLY)-(X - 15 - BALLX, Y - 36 - BALLY), 8πLINE (X - 15 - BALLX, Y - 36 - BALLY)-(X - 11 - BALLX, Y - 30 - BALLY), 8πPAINT (X - 12 - BALLX, Y - 35 - BALLY), SHIRT, 8πLINE (X + 11 - BALLX, Y - 39 - BALLY)-(X + 15 - BALLX, Y - 36 - BALLY), 8πLINE (X + 15 - BALLX, Y - 36 - BALLY)-(X + 10 - BALLX, Y - 32 - BALLY), 8πPAINT (X + 10 - BALLX, Y - 34 - BALLY), SHIRT, 8πLINE (X - 9 - BALLX, Y - 20 - BALLY)-(X - 12 - BALLX, Y - 14 - BALLY), 8πLINE (X - 12 - BALLX, Y - 14 - BALLY)-(X - BALLX, Y - 11 - BALLY), 8πLINE (X - BALLX, Y - 11 - BALLY)-(X - BALLX, Y - 20 - BALLY), 8πPAINT (X - 5 - BALLX, Y - 15 - BALLY), PANTS, 8πLINE (X - BALLX, Y - 20 - BALLY)-(X + 3 - BALLX, Y - 11 - BALLY), 8πLINE (X + 3 - BALLX, Y - 11 - BALLY)-(X + 11 - BALLX, Y - 12 - BALLY), 8πLINE (X + 11 - BALLX, Y - 12 - BALLY)-(X + 9 - BALLX, Y - 20 - BALLY), 8πPAINT (X + 5 - BALLX, Y - 15 - BALLY), PANTS, 8πLINE (X - 9 - BALLX, Y - 12 - BALLY)-(X - 7 - BALLX, Y - 5 - BALLY), 8πLINE (X - 7 - BALLX, Y - 5 - BALLY)-(X - BALLX, Y - 2 - BALLY), 8πLINE (X - BALLX, Y - 2 - BALLY)-(X - 1 - BALLX, Y - 10 - BALLY), 8πPAINT (X - 3 - BALLX, Y - 6 - BALLY), 12, 8πLINE (X - BALLX, Y - 3 - BALLY)-(X - 4 - BALLX, Y + 1 - BALLY), 8πLINE (X - BALLX, Y - 2 - BALLY)-(X - 4 - BALLX, Y + 2 - BALLY), 8πLINE (X - BALLX, Y - 1 - BALLY)-(X - 4 - BALLX, Y + 3 - BALLY), 8πLINE (X + 6 - BALLX, Y - 11 - BALLY)-(X + 3 - BALLX, Y - 3 - BALLY), 8πLINE (X + 3 - BALLX, Y - 3 - BALLY)-(X + 10 - BALLX, Y - 6 - BALLY), 8πLINE (X + 10 - BALLX, Y - 6 - BALLY)-(X + 11 - BALLX, Y - 11 - BALLY), 8πPAINT (X + 8 - BALLX, Y - 7 - BALLY), 12, 8πLINE (X + 3 - BALLX, Y - 3 - BALLY)-(X + 8 - BALLX, Y + 1 - BALLY), 8πLINE (X + 3 - BALLX, Y - 2 - BALLY)-(X + 8 - BALLX, Y + 2 - BALLY), 8πLINE (X + 3 - BALLX, Y - 1 - BALLY)-(X + 8 - BALLX, Y + 3 - BALLY), 8πLINE (X - 14 - BALLX, Y - 35 - BALLY)-(X - 18 - BALLX, Y - 30 - BALLY), 8πLINE (X - 18 - BALLX, Y - 30 - BALLY)-(X - 20 - BALLX, Y - 32 - BALLY), 8πLINE (X - 20 - BALLX, Y - 32 - BALLY)-(X - 22 - BALLX, Y - 30 - BALLY), 8πLINE (X - 22 - BALLX, Y - 30 - BALLY)-(X - 25 - BALLX, Y - 31 - BALLY), 8πLINE (X - 25 - BALLX, Y - 31 - BALLY)-(X - 25 - BALLX, Y - 28 - BALLY), 8πLINE (X - 25 - BALLX, Y - 28 - BALLY)-(X - 20 - BALLX, Y - 26 - BALLY), 8πππLINE (X - 20 - BALLX, Y - 26 - BALLY)-(X - 23 - BALLX, Y - 24 - BALLY), 8πLINE (X - 23 - BALLX, Y - 24 - BALLY)-(X - 20 - BALLX, Y - 22 - BALLY), 8πLINE (X - 20 - BALLX, Y - 22 - BALLY)-(X - 16 - BALLX, Y - 25 - BALLY), 8πLINE (X - 16 - BALLX, Y - 25 - BALLY)-(X - 12 - BALLX, Y - 20 - BALLY), 8πLINE (X - 13 - BALLX, Y - 25 - BALLY)-(X - 15 - BALLX, Y - 28 - BALLY), 8πLINE (X - 15 - BALLX, Y - 28 - BALLY)-(X - 10 - BALLX, Y - 32 - BALLY), 8πPAINT (X - 18 - BALLX, Y - 28 - BALLY), 12, 8πLINE (X + 14 - BALLX, Y - 35 - BALLY)-(X + 19 - BALLX, Y - 31 - BALLY), 8πLINE (X + 19 - BALLX, Y - 31 - BALLY)-(X + 20 - BALLX, Y - 35 - BALLY), 8πLINE (X + 20 - BALLX, Y - 35 - BALLY)-(X + 22 - BALLX, Y - 31 - BALLY), 8πLINE (X + 22 - BALLX, Y - 31 - BALLY)-(X + 25 - BALLX, Y - 32 - BALLY), 8πLINE (X + 25 - BALLX, Y - 32 - BALLY)-(X + 23 - BALLX, Y - 29 - BALLY), 8πLINE (X + 23 - BALLX, Y - 29 - BALLY)-(X + 25 - BALLX, Y - 26 - BALLY), 8πLINE (X + 25 - BALLX, Y - 26 - BALLY)-(X + 18 - BALLX, Y - 25 - BALLY), 8πLINE (X + 18 - BALLX, Y - 25 - BALLY)-(X + 15 - BALLX, Y - 23 - BALLY), 8πLINE (X + 15 - BALLX, Y - 23 - BALLY)-(X + 15 - BALLX, Y - 26 - BALLY), 8πLINE (X + 15 - BALLX, Y - 26 - BALLY)-(X + 11 - BALLX, Y - 31 - BALLY), 8πPAINT (X + 15 - BALLX, Y - 31 - BALLY), 12, 8πRETURNπINSTRUCTIONS:                                            πCLS : PAINT (320, 175), 15: X = 250: Y = 0πGOSUB STRIKER: LOCATE 15, 7πPRINT "Hi there!  I'm Striker, the U.S. ";πPRINT "Soccer Team's mascot.  But enough"πLOCATE 16, 7: PRINT "with the small-talk, I'm ";πPRINT "here to teach you how to play World Cup  "πLOCATE 17, 7: PRINT "94.  World Cup 94 is played ";πPRINT "like a regular soccer game in which   "πLOCATE 18, 7: PRINT "players try to kick the soccer ";πPRINT "ball into the opposing teams goal. "πLOCATE 19, 7: PRINT "Each time the ball is kicked ";πPRINT "into the opposing teams goal, the    "πLOCATE 20, 7: PRINT "player who kicked the ball's ";πPRINT "team will receive a point.  Whichever"πLOCATE 21, 7: PRINT "team receives three points ";πPRINT "first;wins!.                           "πLOCATE 23, 7: INPUT "Press return", A$: CLSπPAINT (320, 175), 15: X = 250: Y = 0πGOSUB STRIKER: LOCATE 15, 7πPRINT "In World Cup 94 each team consists ";πPRINT "of 3 players; 2 field players  "πLOCATE 16, 7: PRINT "and 1 goalie.  You can ";πPRINT "select from 24 different teams to play as. "πLOCATE 17, 7: PRINT "All teams have actual player's ";πPRINT "names that played in World Cup 94. "πLOCATE 23, 7: INPUT "Press return", A$: CLSπPAINT (320, 175), 15: X = 250: Y = -9πGOSUB STRIKER: LOCATE 14, 7πPRINT "The controls for all 6 players ";πPRINT "are as follows:                    "πLOCATE 15, 7: PRINT "   control   |   1   |   2 ";πPRINT "   |   3    |   4   |   5    |   6     "πLOCATE 16, 7: PRINT "             |goalie1|fielder1";πPRINT "|fielder1|goalie2|fielder2|fielder2 "πππLOCATE 17, 7: PRINT "-------------------------------";πPRINT "-----------------------------------"πLOCATE 18, 7: PRINT "     up      |   1   |   E    ";πPRINT "|   U    |   -   |   [    |   8     "πLOCATE 19, 7: PRINT "    left     |  N/A  |   ";πPRINT "S    |   H    |  N/A  |   ;    |   4     "πLOCATE 20, 7: PRINT "    down     |   Q   |   ";πPRINT "X    |   N    |   +   |   /    |   2     "πLOCATE 21, 7: PRINT "   right     |  N/A  |   ";πPRINT "D    |   J    |  N/A  |   '    |   6     "πLOCATE 22, 7: PRINT " shoot/kick  |   `   |   ";πPRINT "R    |   I    |   *   |   ]    |   9     "πLOCATE 23, 7: PRINT "    pass     |  N/A  |   ";πPRINT "W    |   Y    |  N/A  |   P    |   7     "πLOCATE 24, 7: INPUT "Press return", A$πRETURNπCONTROLS:                                                πLPRINT "The controls for all 6 players ";πLPRINT "are as follows:                    "πLPRINT "   control   |   1   |   2 ";πLPRINT "   |   3    |   4   |   5    |   6     "πLPRINT "             |goalie1|fielder1";πLPRINT "|fielder1|goalie2|fielder2|fielder2 "πLPRINT "-------------------------------";πLPRINT "-----------------------------------"πLPRINT "     up      |   1   |   E    ";πLPRINT "|   U    |   -   |   [    |   8     "πLPRINT "    left     |  N/A  |   ";πLPRINT "S    |   H    |  N/A  |   ;    |   4     "πLPRINT "    down     |   Q   |   ";πLPRINT "X    |   N    |   +   |   /    |   2     "πLPRINT "   right     |  N/A  |   ";πLPRINT "D    |   J    |  N/A  |   '    |   6     "πLPRINT " shoot/kick  |   `   |   ";πLPRINT "R    |   I    |   *   |   ]    |   9     "πLPRINT "    pass     |  N/A  |   ";πLPRINT "W    |   Y    |  N/A  |   P    |   7     "πRETURNπSELECTION:                                               πCLS : FOR G = 1 TO 100: LOCATE 12, 33πPRINT "Team Selection": FOR T = 1 TO 50: NEXT TπLOCATE 12, 33: PRINT "              ": FOR T = 1 TO 50πNEXT T: NEXT G: CLS : PL = 1: NUMBER = 1: PICKED = 0π10010 K = 0πIF NUMBER = PICKED THENπ IF A$ = "4" THENπ  NUMBER = NUMBER - 1π ELSEπ  NUMBER = NUMBER + 1π END IFπEND IFπIF NUMBER < 1 THEN NUMBER = 24πIF NUMBER > 24 THEN NUMBER = 1πIF NUMBER = PICKED THENπππ IF A$ = "4" THENπ  NUMBER = NUMBER - 1π ELSEπ  NUMBER = NUMBER + 1π END IFπEND IFπIF NUMBER < 1 THEN NUMBER = 23πIF NUMBER > 24 THEN NUMBER = 2πIF NUMBER = 1 THEN COUNTRY$ = "U.S.A.": GOSUB USAπIF NUMBER = 2 THEN COUNTRY$ = "Switzerland": GOSUB SWITZERLANDπIF NUMBER = 3 THEN COUNTRY$ = "Romania": GOSUB ROMANIAπIF NUMBER = 4 THEN COUNTRY$ = "Colombia": GOSUB COLOMBIAπIF NUMBER = 5 THEN COUNTRY$ = "Brazil": GOSUB BRAZILπIF NUMBER = 6 THEN COUNTRY$ = "Cameroon": GOSUB CAMEROONπIF NUMBER = 7 THEN COUNTRY$ = "Sweden": GOSUB SWEDENπIF NUMBER = 8 THEN COUNTRY$ = "Russia": GOSUB RUSSIAπIF NUMBER = 9 THEN COUNTRY$ = "Germany": GOSUB GERMANYπIF NUMBER = 10 THEN COUNTRY$ = "Spain": GOSUB SPAINπIF NUMBER = 11 THEN COUNTRY$ = "South Korea": GOSUB SOUTHKOREAπIF NUMBER = 12 THEN COUNTRY$ = "Bolivia": GOSUB BOLIVIAπIF NUMBER = 13 THEN COUNTRY$ = "Argentina": GOSUB ARGENTINAπIF NUMBER = 14 THEN COUNTRY$ = "Nigeria": GOSUB NIGERIAπIF NUMBER = 15 THEN COUNTRY$ = "Bulgaria": GOSUB BULGARIAπIF NUMBER = 16 THEN COUNTRY$ = "Greece": GOSUB GREECEπIF NUMBER = 17 THEN COUNTRY$ = "Ireland": GOSUB IRELANDπIF NUMBER = 18 THEN COUNTRY$ = "Norway": GOSUB NORWAYπIF NUMBER = 19 THEN COUNTRY$ = "Italy": GOSUB ITALYπIF NUMBER = 20 THEN COUNTRY$ = "Mexico": GOSUB MEXICOπIF NUMBER = 21 THEN COUNTRY$ = "Belgium": GOSUB BELGIUMπIF NUMBER = 22 THEN COUNTRY$ = "Netherlands": GOSUB NETHERLANDSπIF NUMBER = 23 THEN COUNTRY$ = "Saudi Arabia": GOSUB SAUDIARABIAπIF NUMBER = 24 THEN COUNTRY$ = "Morocco": GOSUB MOROCCOπLOCATE 22, 11: PRINT "'4' or '6' to see a different ";πPRINT "team, '5' to select this team"πLOCATE 24, 20: PRINT "What is your choice, player"; PL;πA$ = " "π10015 A$ = INKEY$πIF A$ <> "4" AND A$ <> "5" AND A$ <> "6" THEN GOTO 10015πIF A$ = "4" THEN NUMBER = NUMBER - 1: GOTO 10010πIF A$ = "6" THEN NUMBER = NUMBER + 1: GOTO 10010πIF A$ = "5" THENπ IF PL = 1 THENπ  HANDS1 = HANDS: NAME11$ = NAME1$: NAME12$ = NAME2$π  GOALIE1$ = GOALIE$: STEAL1 = STEAL: SPEED1 = SPEEDπ  K = 1: COUNTRY1$ = COUNTRY$: PICKED = NUMBERπ ELSEπ  NAME21$ = NAME1$: NAME22$ = NAME2$π  GOALIE2$ = GOALIE$: COUNTRY2$ = COUNTRY$π  STEAL2 = STEAL: SPEED2 = SPEED: HANDS2 = HANDS: K = 2π END IFπEND IFπIF K = 1 THEN PL = 2: NUMBER = 1πIF K <> 2 THEN GOTO 10010πCLS : FOR G = 1 TO 100πππLOCATE 12, 31: PRINT "Uniform Selection"πFOR T = 1 TO 40: NEXT TπLOCATE 12, 32: PRINT "                 "πFOR T = 1 TO 40: NEXT T: NEXT G: CLS : PL = 1π10020 CLS : LOCATE 2, 31: PRINT "Color number chart"πLOCATE 3, 20πPRINT "-----------------------------------------"πLOCATE 4, 20: PRINT "0 = black             |   6 = brown"πLOCATE 5, 20: PRINT "1 = blue              |   8 = gray"πLOCATE 6, 20πPRINT "2=green(only w/shorts)|   9 = light blue"πLOCATE 7, 20πPRINT "3 = cyan              |  10 = light green"πLOCATE 8, 20πPRINT "4 = red               |  11 = light cyan"πLOCATE 9, 20πPRINT "5 = magenta           |  14 = yellow"πLOCATE 10, 20: PRINT "                      |  15 = white"πLOCATE 12, 20πPRINT "-----------------------------------------"πLOCATE 13, 20πPRINT "What color jersey do you want player"; PL;πINPUT SHIRT: LOCATE 14, 20πPRINT "What color shorts do you want player"; PL;πINPUT PANTSπIF SHIRT <> 15 AND SHIRT <> 0 AND SHIRT <> 1 AND SHIRT <> 3 AND SHIRT <> 4 AND SHIRT <> 5 AND SHIRT <> 8 AND SHIRT <> 9 AND SHIRT <> 10 AND SHIRT <> 11 AND SHIRT <> 14 AND SHIRT <> 6 THEN LOCATE 16, 25: PRINT "You entered a non-valid shirt color": INPUT A$: GOTO 10020πIF PANTS <> 15 AND PANTS <> 0 AND PANTS <> 1 AND PANTS <> 2 AND PANTS <> 3 AND PANTS <> 4 AND PANTS <> 5 AND PANTS <> 8 AND PANTS <> 9 AND PANTS <> 10 AND PANTS <> 11 AND PANTS <> 14 AND PANTS <> 6 THEN LOCATE 16, 25: PRINT "You entered a non-valid shorts color": INPUT A$: GOTO 10020π10030 CLS : GOSUB DEMO: LOCATE 17, 23πPRINT "Does this look okay, player"; PL; : INPUT A$πIF A$ = "N" OR A$ = "NO" THEN GOTO 10020πIF A$ = "Y" OR A$ = "YE" OR A$ = "YES" THEN GOTO 10040πGOTO 10030π10040 IF PL = 1 THENπ SHIRT1 = SHIRT: PANTS1 = PANTS: PL = 2: BALLX = -320π BALLY = -175: DIM GUY1%(1 TO 2000)π GET (290, 90)-(350, 180), GUY1%: GOTO 10020πEND IFπDIM GUY2%(1 TO 2000): GET (290, 90)-(350, 180), GUY2%πSHIRT2 = SHIRT: PANTS2 = PANTS: SCORE1 = 0: SCORE2 = 0πCLS : LOCATE 12, 18πPRINT "Make sure that Caps Lock and Num Lock are on"πFOR T = 1 TO 15000: NEXT TπRETURNπDEMO:                                                    πBALLX = -320: BALLY = -175: X = 0: Y = 0: GOSUB PLAYERπRETURNπMAINGAME:                                                πππ12000 BALLX = 80: BALLY = 105: GOALY1 = 280πGOALY2 = 280: FIELDER11X = 300: FIELDER12X = 300πFIELDER11Y = 230: FIELDER12Y = 330: FIELDER21X = 500πFIELDER22X = 500: FIELDER21Y = 230: FIELDER22Y = 330πCONTROL = 0: POWER = 0: PREV = 0: GOAL1 = 0: GOAL2 = 0πSCREEN 9, , 0, 0: CLS : PCOPY 0, 1π20000 SCREEN 9, , 0, 1: GOSUB DRAWSTUFFπIF GOAL1 = 1 OR GOAL2 = 1 THEN SCREEN 9, , 0, 0: GOTO 50000πSCREEN 9, , 0, 0: PCOPY 0, 1πC$ = " "πC$ = INKEY$π20010 IF C$ <> " " THEN GOSUB INTERPRETπIF POWER < 0 THEN PREV = 0πIF POWER > 0 THEN BALLX = BALLX + DX: BALLY = BALLY + DYπIF POWER > -4 THEN POWER = POWER - 1πLET NUM = INT(RND(1) * 125) + 1πIF BALLX + 320 > FIELDER11X - 16 AND BALLX + 320 < FIELDER11X + 16 AND BALLY + 175 > FIELDER11Y - 16 AND BALLY + 175 < FIELDER11Y + 16 AND NUM < STEAL1 THEN CONTROL = 2πIF BALLX + 320 > FIELDER12X - 16 AND BALLX + 320 < FIELDER12X + 16 AND BALLY + 175 > FIELDER12Y - 16 AND BALLY + 175 < FIELDER12Y + 16 AND NUM < STEAL1 THEN CONTROL = 3πIF BALLX + 320 > FIELDER21X - 16 AND BALLX + 320 < FIELDER21X + 16 AND BALLY + 175 > FIELDER21Y - 16 AND BALLY + 175 < FIELDER21Y + 16 AND NUM < STEAL2 THEN CONTROL = 5πIF BALLX + 320 > FIELDER22X - 16 AND BALLX + 320 < FIELDER22X + 16 AND BALLY + 175 > FIELDER22Y - 16 AND BALLY + 175 < FIELDER22Y + 16 AND NUM < STEAL2 THEN CONTROL = 6πIF (NUM - 40) < HANDS1 AND BALLX + 320 > -180 - 40 AND BALLX + 320 < -180 + 60 AND BALLY + 175 > GOALY1 - 100 AND BALLY + 175 < GOALY1 + 40 THEN CONTROL = 1πIF (NUM - 40) < HANDS2 AND BALLX + 320 > 980 - 60 AND BALLX + 320 < 980 + 40 AND BALLY + 175 > GOALY2 - 100 AND BALLY + 175 < GOALY2 + 40 THEN CONTROL = 4πIF CONTROL = 2 AND PREV <> 2 THENπ BALLX = FIELDER11X - 320π BALLY = FIELDER11Y - 175: DX = 0: DY = 0πEND IFπIF CONTROL = 3 AND PREV <> 3 THENπ BALLX = FIELDER12X - 320π BALLY = FIELDER12Y - 175: DX = 0: DY = 0πEND IFπIF CONTROL = 5 AND PREV <> 5 THENπ BALLX = FIELDER21X - 320π BALLY = FIELDER21Y - 175: DX = 0: DY = 0πEND IFπIF CONTROL = 6 AND PREV <> 6 THENπ BALLX = FIELDER22X - 320π BALLY = FIELDER22Y - 175: DX = 0: DY = 0πEND IFπIF CONTROL = 4 AND PREV <> 4 THENπ BALLX = 920 - 320: BALLY = GOALY2 - 175πEND IFπIF CONTROL = 1 AND PREV <> 1 THENπ BALLX = -120 - 320: BALLY = GOALY1 - 175πEND IFπIF GOALY1 > 580 THEN GOALY1 = 580πIF GOALY1 < -20 THEN GOALY1 = -20πIF GOALY2 > 580 THEN GOALY2 = 580πππIF GOALY2 < -20 THEN GOALY2 = -20πIF FIELDER11X > 1000 THEN FIELDER11X = 1000πIF FIELDER11X < -200 THEN FIELDER11X = -200πIF FIELDER11Y > 580 THEN FIELDER11Y = 580πIF FIELDER11Y < -20 THEN FIELDER11Y = -20πIF FIELDER12X > 1000 THEN FIELDER12X = 1000πIF FIELDER12X < -200 THEN FIELDER12X = -200πIF FIELDER12Y > 580 THEN FIELDER12Y = 580πIF FIELDER12Y < -20 THEN FIELDER12Y = -20πIF FIELDER21X > 1000 THEN FIELDER21X = 1000πIF FIELDER21X < -200 THEN FIELDER21X = -200πIF FIELDER21Y > 580 THEN FIELDER21Y = 580πIF FIELDER21Y < -20 THEN FIELDER21Y = -20πIF FIELDER22X > 1000 THEN FIELDER22X = 1000πIF FIELDER22X < -200 THEN FIELDER22X = -200πIF FIELDER22Y > 580 THEN FIELDER22Y = 580πIF FIELDER22Y < -20 THEN FIELDER22Y = -20πIF BALLY < -195 THEN BALLY = -195πIF BALLY > 405 THEN BALLY = 405πIF BALLY < 5 AND BALLX < -520 THEN BALLX = -520πIF BALLY > 205 AND BALLX < -520 THEN BALLX = -520πIF BALLY < 5 AND BALLX > 680 THEN BALLX = 680πIF BALLY > 205 AND BALLX > 680 THEN BALLX = 680πIF BALLX < -520 THEN GOAL1 = 1πIF BALLX > 680 THEN GOAL2 = 1πGOTO 20000πRETURNπDRAWSTUFF:                                               πGOSUB SOCCERFIELDπIF FIELDER11X > BALLX + 35 AND FIELDER11X < BALLX + 605 AND FIELDER11Y > BALLY + 90 AND FIELDER11Y < BALLY + 340 THENπ PUT (FIELDER11X - 30 - BALLX, FIELDER11Y - 90 - BALLY), GUY1%, ORπEND IFπIF FIELDER12X > BALLX + 35 AND FIELDER12X < BALLX + 605 AND FIELDER12Y > BALLY + 90 AND FIELDER12Y < BALLY + 340 THENπ PUT (FIELDER12X - 30 - BALLX, FIELDER12Y - 90 - BALLY), GUY1%, ORπEND IFπIF FIELDER21X > BALLX + 35 AND FIELDER21X < BALLX + 605 AND FIELDER21Y > BALLY + 90 AND FIELDER21Y < BALLY + 340 THENπ PUT (FIELDER21X - 30 - BALLX, FIELDER21Y - 90 - BALLY), GUY2%, ORπEND IFπIF FIELDER22X > BALLX + 35 AND FIELDER22X < BALLX + 605 AND FIELDER22Y > BALLY + 90 AND FIELDER22Y < BALLY + 340 THENπ PUT (FIELDER22X - 30 - BALLX, FIELDER22Y - 90 - BALLY), GUY2%, ORπEND IFπIF -180 > BALLX + 35 AND -180 < BALLX + 605 AND GOALY1 > BALLY + 90 AND GOALY1 < BALLY + 340 THENπ PUT (-180 - 30 - BALLX, GOALY1 - 90 - BALLY), GUY1%, ORπEND IFπIF 980 > BALLX + 35 AND 980 < BALLX + 605 AND GOALY2 > BALLY + 90 AND GOALY2 < BALLY + 340 THENπ PUT (980 - 30 - BALLX, GOALY2 - 90 - BALLY), GUY2%, ORπEND IFπRETURNπINTERPRET:                                               πLET NU = INT(RND(1) * 5) + 1πππIF NU = 1 THEN NUM = -99πIF NU = 2 THEN NUM = 99πIF NU = 3 THEN NUM = 0πIF NU = 4 THEN NUM = 50πIF NU = 5 THEN NUM = -50πIF C$ = "1" THEN GOALY1 = GOALY1 - 10 - SPEED1πIF C$ = "Q" THEN GOALY1 = GOALY1 + 10 + SPEED1πIF C$ = "`" AND CONTROL = 1 THENπ POWER = 40: DX = 20π LET DY = ((INT(RND(1) * 600)) - 300) / POWERπ CONTROL = 0: PREV = 1: BALLX = BALLX + 20πEND IFπIF C$ = "E" THEN FIELDER11Y = FIELDER11Y - 10 - SPEED1πIF C$ = "S" THEN FIELDER11X = FIELDER11X - 10 - SPEED1πIF C$ = "X" THEN FIELDER11Y = FIELDER11Y + 10 + SPEED1πIF C$ = "D" THEN FIELDER11X = FIELDER11X + 10 + SPEED1πIF C$ = "W" AND CONTROL = 2 THENπ POWER = 15π DX = (FIELDER11X - FIELDER12X) / (POWER * -1)π DY = (FIELDER11Y - FIELDER12Y) / (POWER * -1): PREV = 2π CONTROL = 0πEND IFπIF C$ = "R" AND CONTROL = 2 THENπ POWER = 17π DX = (FIELDER11X - 1010) / (POWER * -1)π DY = (FIELDER11Y - 280 + NUM) / (POWER * -1)π PREV = 2: CONTROL = 0πEND IFπIF C$ = "U" THEN FIELDER12Y = FIELDER12Y - 10 - SPEED1πIF C$ = "H" THEN FIELDER12X = FIELDER12X - 10 - SPEED1πIF C$ = "N" THEN FIELDER12Y = FIELDER12Y + 10 + SPEED1πIF C$ = "J" THEN FIELDER12X = FIELDER12X + 10 + SPEED1πIF C$ = "Y" AND CONTROL = 3 THENπ POWER = 15π DX = (FIELDER12X - FIELDER11X) / (POWER * -1)π DY = (FIELDER12Y - FIELDER11Y) / (POWER * -1)π PREV = 3: CONTROL = 0πEND IFπIF C$ = "I" AND CONTROL = 3 THENπ POWER = 17: DX = (FIELDER12X - 1010) / (POWER * -1)π DY = (FIELDER12Y - 280 + NUM) / (POWER * -1)π PREV = 3: CONTROL = 0πEND IFπIF C$ = "-" THEN GOALY2 = GOALY2 - 10 - SPEED2πIF C$ = "+" THEN GOALY2 = GOALY2 + 10 + SPEED2πIF C$ = "*" AND CONTROL = 4 THENπ POWER = 40: DX = -20π LET DY = ((INT(RND(1) * 600)) - 300) / POWERπ CONTROL = 0: PREV = 4: BALLX = BALLX - 20πEND IFπIF C$ = "[" THEN FIELDER21Y = FIELDER21Y - 10 - SPEED2πIF C$ = ";" THEN FIELDER21X = FIELDER21X - 10 - SPEED2πIF C$ = "/" THEN FIELDER21Y = FIELDER21Y + 10 + SPEED2πIF C$ = "'" THEN FIELDER21X = FIELDER21X + 10 + SPEED2πIF C$ = "P" AND CONTROL = 5 THENπ POWER = 15π DX = (FIELDER21X - FIELDER22X) / (POWER * -1)π DY = (FIELDER21Y - FIELDER22Y) / (POWER * -1)π PREV = 5: CONTROL = 0πEND IFπππIF C$ = "]" AND CONTROL = 5 THENπ POWER = 17: DX = (FIELDER21X + 210) / (POWER * -1)π DY = (FIELDER21Y - 280 + NUM) / (POWER * -1)π PREV = 5: CONTROL = 0πEND IFπIF C$ = "8" THEN FIELDER22Y = FIELDER22Y - 10 - SPEED2πIF C$ = "4" THEN FIELDER22X = FIELDER22X - 10 - SPEED2πIF C$ = "2" THEN FIELDER22Y = FIELDER22Y + 10 + SPEED2πIF C$ = "6" THEN FIELDER22X = FIELDER22X + 10 + SPEED2πIF C$ = "7" AND CONTROL = 6 THENπ POWER = 15π DX = (FIELDER22X - FIELDER21X) / (POWER * -1)π DY = (FIELDER22Y - FIELDER21Y) / (POWER * -1)π PREV = 6: CONTROL = 0πEND IFπIF C$ = "9" AND CONTROL = 6 THENπ POWER = 17: DX = (FIELDER22X + 210) / (POWER * -1)π DY = (FIELDER22Y - 280 + NUM) / (POWER * -1): PREV = 6: CONTROL = 0πEND IFπ40000 REM                                                πIF ABS(DX) > 30 THEN DX = DX * .95: DY = DY * .95πIF ABS(DY) > 30 THEN DX = DX * .95: DY = DY * .95πIF ABS(DX) > 30 OR ABS(DY) > 30 THEN GOTO 40000πRETURNπ50000 REM GOAL                                           πSCORER$ = "Z%": IF PREV = 1 THEN SCORER$ = GOALIE1$πIF PREV = 2 THEN SCORER$ = NAME11$πIF PREV = 3 THEN SCORER$ = NAME12$πIF PREV = 4 THEN SCORER$ = GOALIE2$πIF PREV = 5 THEN SCORER$ = NAME21$πIF PREV = 6 THEN SCORER$ = NAME22$πIF SCORER$ = "Z%" AND CONTROL = 1 THEN SCORER$ = GOALIE1$πIF SCORER$ = "Z%" AND CONTROL = 2 THEN SCORER$ = NAME11$πIF SCORER$ = "Z%" AND CONTROL = 3 THEN SCORER$ = NAME12$πIF SCORER$ = "Z%" AND CONTROL = 4 THEN SCORER$ = GOALIE2$πIF SCORER$ = "Z%" AND CONTROL = 5 THEN SCORER$ = NAME21$πIF SCORER$ = "Z%" AND CONTROL = 6 THEN SCORER$ = NAME22$πLOCATE 12, 36: PRINT "Goal!!!!": LOCATE 14, 25πIF SCORER$ <> "Z" THEN PRINT "Goal scored by ";πIF SCRORE$ <> "Z" THEN PRINT SCORER$; " !!!!!!"πFOR T1 = 1 TO 5: FOR T2 = 37 TO 14000 STEP 1000πSOUND T2, 1: NEXT T2: NEXT T1: FOR T1 = 1 TO 30πLET T2 = INT(RND(1) * 500) + 2000: SOUND T2, 1πNEXT T1: CLS : SCORE1 = SCORE1 + GOAL2πSCORE2 = SCORE2 + GOAL1: LOCATE 12, 30πPRINT COUNTRY1$; SCORE1; "-"; SCORE2; COUNTRY2$πFOR T3 = 1 TO 60000: NEXT T3πGOAL1 = 0: GOAL2 = 0πIF SCORE1 > 2 OR SCORE2 > 2 THEN GOTO 60000πGOTO 12000π60000 RETURNπENDππ'That's all Folks     By A|@* Makris at CRPY26CπBen Kington                    SPACE MAN FRED                 comp.lang.basic.misc           08-21-96 (14:55)       QB, QBasic, PDS        431  9197     SPACEMAN.BAS'Space Man Fred v 1.1π'by Ben Kingtonππshphlth = 60πagn:πskipinto:πRANDOMIZE TIMERπ'notes to my self:π'K=Leftπ'M=Rightπ'P=Downπ'H = Upπcokcol = 1πSCREEN 13ππa = 160  'Define some variablesπmis = 3πen = 5πenm = 1πenspd = 1πtimens = INT(TIMER + 120 - enspd)πenaway = 6πencol = 1πavt = 165πenv = 10πshphlth = 60πstarx1 = INT(RND * 319) + 1 'Make ten starsπstary1 = INT(RND * 199) + 1πstarx2 = INT(RND * 319) + 1πstary2 = INT(RND * 199) + 1πstarx3 = INT(RND * 319) + 1πstary3 = INT(RND * 199) + 1πstarx4 = INT(RND * 319) + 1πstary4 = INT(RND * 199) + 1πstarx5 = INT(RND * 319) + 1πstary5 = INT(RND * 199) + 1πstarx6 = INT(RND * 199) + 1πstary6 = INT(RND * 319) + 1πstarx7 = INT(RND * 199) + 1πstary7 = INT(RND * 319) + 1πstarx8 = INT(RND * 199) + 1πstary8 = INT(RND * 319) + 1πstarx9 = INT(RND * 199) + 1πstary9 = INT(RND * 319) + 1πstarx10 = INT(RND * 199) + 1πstary10 = INT(RND * 319) + 1πPSET (starx1, stary1), 15πPSET (starx2, stary1), 15πPSET (starx3, stary3), 15πPSET (starx4, stary4), 15πPSET (starx5, stary5), 15πPSET (stary6, starx6), 15πPSET (stary7, starx7), 15πPSET (stary8, starx8), 15πPSET (stary9, starx9), 15πPSET (stary10, starx10), 15πplanx = INT(RND * 290) + 30πplany = INT(RND * 170) + 30πpc = 1πrc = 4πDOπCOLOR 0πLINE (planx - 30, plany - 30)-(planx + 30, plany + 30), , BFπCOLOR 15πCIRCLE (planx, plany), 20, pcπPAINT (planx, plany - 15), pcπPAINT (planx, plany + 15), pcπCIRCLE (planx, plany), 30, rc, , , .1πLINE (planx - 17, plany - 3)-(planx + 17, plany - 3), pcπLINE (planx - 20, plany - 2)-(planx + 20, plany - 2), pcπplany = plany + 1πIF plany > 450 THENπplanx = INT(RND * 290) + 30πplany = 0πpc = INT(RND * 15) + 1πrc = INT(RND * 15) + 1πIF rc = pc THEN rc = INT(RND * 15) + 1πCOLOR 0πLINE (planx - 25, plany - 25)-(planx + 25, plany + 25), , BFπCOLOR 15πEND IFππPSET (starx1, stary1), 0πPSET (starx2, stary1), 0πPSET (starx1, stary1), 0πPSET (starx3, stary3), 0πPSET (starx4, stary4), 0πPSET (starx5, stary5), 0πPSET (stary6, starx6), 0πPSET (stary7, starx7), 0πPSET (stary8, starx8), 0πPSET (stary9, starx9), 0πPSET (stary10, starx10), 0ππstary1 = stary1 + 1πstary2 = stary2 + 2πstary3 = stary3 + 1πstary4 = stary4 + 1πstary5 = stary5 + 2πstarx6 = starx6 + 1πstarx7 = starx7 + 1πstarx8 = starx8 + 2πstarx9 = starx9 + 1πstarx10 = starx10 + 2πIF stary1 > 200 THENπstary1 = 0πstarx1 = INT(RND * 320) + 1πEND IFπIF stary2 > 200 THENπstary2 = 0πstarx2 = INT(RND * 320) + 1πEND IFπIF stary3 > 200 THENπstary3 = 0πstarx3 = INT(RND * 320) + 1πEND IFπIF stary4 > 200 THENπstary4 = 0πstarx4 = INT(RND * 320) + 1πEND IFπIF stary5 > 200 THENπstary5 = 0πstarx5 = INT(RND * 320) + 1πEND IFπIF starx6 > 200 THENπstarx6 = 0πstary6 = INT(RND * 320) + 1πEND IFπIF starx7 > 200 THENπstarx7 = 0πstary7 = INT(RND * 320) + 1πEND IFπIF starx8 > 200 THENπstarx8 = 0πstary8 = INT(RND * 320) + 1πEND IFπIF starx9 > 200 THENπstarx9 = 0πstary9 = INT(RND * 320) + 1πEND IFπIF starx10 > 200 THENπstarx10 = 0πstary10 = INT(RND * 320) + 1πEND IFπPSET (starx2, stary1), 15πPSET (starx3, stary3), 15πPSET (starx4, stary4), 15πPSET (starx5, stary5), 15πPSET (stary6, starx6), 15πPSET (stary7, starx7), 15πPSET (stary8, starx8), 15πPSET (stary9, starx9), 15πPSET (stary10, starx10), 15ππCOLOR 15πLINE (4, 185)-(66, 190), , BππCOLOR 1πLINE (5, 186)-(5 + shphlth, 189), , BFππtimen = INT(timens - TIMER)πCOLOR 15πLOCATE 1, 1πPRINT "Score: "; scr; " Timer:"; timen; " Missles:"; misπen1 = en - 5πen2 = en + 5πCOLOR 0πLINE (en1 - 1, env - 1)-(en2 + 1, env + 11), , BFπCOLOR encolπLINE (en1, env)-(en2, env) 'DRAW THE ENEMYπLINE (en1, env)-(en1, env + 5)πLINE (en2, env)-(en2, env + 5)πLINE (en2, env + 5)-(en1, env + 5)πLINE (en, env + 5)-(en, env + 10)πPAINT (en, env + 1)ππCHUNK$ = UCASE$(INKEY$)πb1 = a + 10πb2 = a - 10πc = b1 - 2πd = b2 + 2πavb = avt + 15πabh = avb - 2πSELECT CASE CHUNK$πCASE CHR$(0) + "M"πIF b1 <> 320 THEN a = a + 10π'SOUND 60, 1πCASE CHR$(0) + "K"πIF b2 <> 1 THEN a = a - 10π'SOUND 60, 1πCASE CHR$(0) + "P"πIF avt <> 190 THEN avt = avt + 5πCASE CHR$(0) + "H"πIF avt <> 10 THEN avt = avt - 5πCASE CHR$(32)πππSOUND 1000, 1π'LINE (a, avt)-(a, env), 4πCOLOR 15πLINE (a, avt)-(b1, avb) 'Draw the shipπLINE (a, avt)-(b2, avb)πLINE (c, abh)-(d, abh)πCIRCLE (a, avt + 5), 2, cokcolπPAINT (a, avt + 5), cokcolπshot = avtπDOπCOLOR 15πLINE (a, avt)-(b1, avb) 'Draw the shipπLINE (a, avt)-(b2, avb)πLINE (c, abh)-(d, abh)πCIRCLE (a, avt + 5), 2, cokcolπPAINT (a, avt + 5), cokcolππCIRCLE (a, shot + 5), 2, 0πCIRCLE (a, shot + 5), 1, 0πPSET (a, shot + 5), 0πPSET (a, shot), 4πCIRCLE (a, shot), 1, 44πCIRCLE (a, shot), 2, 111π'PLAY "p64"πfdel = TIMERπdel = TIMER + .004πDO: LOOP WHILE del > TIMERπshot = shot - 5πLOOP WHILE shot > envπππCIRCLE (a, shot + 5), 2, 0πCIRCLE (a, shot + 5), 1, 0πPSET (a, shot + 5), 0ππIF a > en1 - 3 AND a < en2 + 3 THEN ens = 2πCASE CHR$(48)πIF mis > 0 AND avt > env THENπLINE (a, avt)-(en, env), 2πSOUND 1000, 1πgoo = INT(TIMER)πgooer = goo + 1ππDOπLOOP WHILE gooer <> INT(TIMER)πmis = mis - 1πens = 2πLINE (a, avt)-(en, env), 0πEND IFπEND SELECTππCOLOR 0πLINE (b1 + 15, avt - 16)-(b2 - 15, avb + 16), , BFπCOLOR 15πLINE (a, avt)-(b1, avb) 'Draw the shipπLINE (a, avt)-(b2, avb)πLINE (c, abh)-(d, abh)πCIRCLE (a, avt + 5), 2, cokcolπPAINT (a, avt + 5), cokcolπen1 = en - 5πen2 = en + 5πCOLOR encolππLINE (en1, env)-(en2, env) 'DRAW THE ENEMYπLINE (en1, env)-(en1, env + 5)πLINE (en2, env)-(en2, env + 5)πLINE (en2, env + 5)-(en1, env + 5)πLINE (en, env + 5)-(en, env + 10)πPAINT (en, env + 1)ππemover = INT(RND * 100) + 1  'move the enemyπ'                  ^^^  This number determines how often the enemyπ'changes directions.πIF emover = 1 AND emove <> 2 THEN emove = 2πIF emover = 2 AND emove <> 1 THEN emove = 1πIF emover = 3 AND emovev <> 1 THEN emovev = 1πIF emover = 4 AND emovev <> 2 THEN emovev = 2πIF en = 5 THEN emove = 1πIF en > 315 THEN emove = 2πIF env = 2 THEN emovev = 1πIF env = 179 OR env > 179 THEN emovev = 2πIF emove = 1 THEN en = en + 1πIF emove = 2 THEN en = en - 1πIF emovev = 1 THEN env = env + 1πIF emovev = 2 THEN env = env - 1πIF en < b1 AND en > b2 AND env + 30 > avt AND env < avt THENπLINE (en, env + 10)-(en, avt + 10), 14ππshipst = 2πππPLAY "<<<c"ππgob = TIMERπgooober = gob + 1πDO WHILE gooober > gobπgob = TIMERπLOOPππCOLOR 0πLINE (en1 - 1, env - 1)-(en2 + 1, env + 11), , BFπCOLOR 15πen = 5πenv = 10πEND IFπIF shipst = 2 THENπshphlth = shphlth - 10πCOLOR 0πLINE (b1 + 15, avt - 16)-(b2 - 15, avb + 16), , BFπLINE (4, 185)-(66, 190), , BFπCOLOR 15πshipst = 1πEND IFππIF ens = 2 THEN 'Kill the enemyπ'FOR exspld = 1 TO 10π'CIRCLE (en, env), exspld, 8πSOUND 100, 2πSOUND 130, 2πSOUND 90, 2π'NEXT exspldππππCOLOR 0πLINE (en1 - 1, env - 1)-(en2 + 1, env + 11), , BFππFOR firex = 1 TO 200ππx = INT(RND * 15) + 1πxb = INT(RND * 15) + 1πyb = INT(RND * 15) + 1πy = INT(RND * 15) + 1πc = INT(RND * 10) + 1πIF c = 1 THEN f = 40πIF c = 2 THEN f = 116πIF c = 3 THEN f = 111πIF c = 4 THEN f = 44πIF c = 5 THEN f = 43πIF c = 6 THEN f = 42πIF c = 7 THEN f = 41πIF c = 8 THEN f = 184πIF c = 9 THEN f = 188πIF c = 10 THEN f = 184πx1 = en + x - xbπy1 = env + y - ybπPSET (x1, y1), fπNEXT firexπCLSπCOLOR 0πLINE (en1 - 55, env - 55)-(en2 + 55, env + 51), , BFπCOLOR 15ππtbon = tbon + timenπIF enkill = 5 THEN enspd = enspd + 5: enkill = 0πenkill = enkill + 1πtimens = INT(TIMER + 65 - enspd)πscr = scr + 100 * enspdπen = INT(RND * 315) + 5πens = 1ππencol = encol + 1πIF encol = 15 THEN encol = 1πCOLOR 0πLINE (en1 - 15, env - 15)-(en2 + 15, env + 21), , BFπCOLOR 15πtimeen = timen / 8πIF shphlth + timeen < 60 OR shphlth + timeen = 60 THEN shphlth = shphlth +πtimeenπCOLOR 15ππCOLOR 15πEND IFπLOOP WHILE INKEY$ <> CHR$(27) AND enspd < 115 AND timen > 0 AND shphlth >π0πCOLOR encolππCOLOR 15πPRINT "Score:"; scrπPRINT "Time bonus:"; tbonπPRINT "Final Score:"; scr + tbonπIF timen < 0 OR timen = 0 THENπCOLOR 14  'kill the earthπLINE (en, env + 16)-(1, 200)πLINE (en, env + 16)-(320, 200)πPAINT (en, env + 17)πLINE (b2, avt + 30)-(b1, avt - 30), , BFππgmovr:πLOCATE 13, 15πCOLOR 4ππPRINT "Game Over!"πSOUND 100, 2πSOUND 200, 2πSOUND 100, 2πshphlth = 1πEND IFπIF shphlth < 0 OR shphlth = 0 THENπFOR slip = 1 TO 30πCIRCLE (a, avt + 5), slip, 8πSOUND 100 + slip, 1πNEXT slipπGOSUB gmovrπEND IFπIF enspd = 115 THENπCOLOR 15πPRINT "Thank you for saving the earth, here is a medal for your bravery:"πLINE (140, 50)-(180, 50), 4πLINE (140, 50)-(140, 90), 4πLINE (180, 50)-(180, 90), 4πLINE (180, 90)-(160, 110), 4πLINE (140, 90)-(160, 110), 4πPAINT (160, 105), 4πCIRCLE (160, 140), 30, 44πPAINT (160, 140), 44πEND IFπINPUT "Would you like to play again?", agn$πIF agn$ = "y" OR agn$ = "Y" THEN GOSUB agnπSYSTEMππSUB earthπCOLOR 14πLINE (en, 21)-(1, 200)πLINE (en, 21)-(320, 200)πPAINT (en, 32)πLINE (a, 165)-(b1, 180) 'kill the shipπLINE (a, 165)-(b2, 180)πLINE (c, 178)-(d, 178)πLOCATE 13, 15πCOLOR 4πPRINT "Game Over!"ππEND SUBπJames McMurrin                 MATHEMATICAL WORMS OF XANTHE   FidoNet QUIK_BAS Echo          11-25-92 (00:00)       QB, QBasic, PDS        90  5908     WORM.BAS    DEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"WORM.ZIP",4^6:Z&=4158:?STRING$(50,177);πU"%up()%9%%%#-%Lj.AFHn1]<G.7%%$=%%%-%.%%&t%wrSgIfxl'<bAT]=7w(OB6hπU"ldaOCVf;Wc[AA]X*$-)AVn%ME9j9ltBM22&;NjPBjBtBfwXftFEp,4/#%L4,#9KπU"fO*92CNL%\L%35tPjeo:;1$3*_ZZQt6LTTt>)37t.;m<$[M2d-db?cQXENTf>L'πU"&0hdL_STcK2fq_l(50S;5rAf^[?0^m3W7-HepXg;vP9/S^9L^UR0w]RtcD>B%$wπU"?d>Z.n;Md_ZajsLq/1R,IElT.vudOy?O?Zd^0j$r>IlBd'5<uotmgcDf1gtuXY<πU"11=>cBH1o?Ub*&/**s4D4dHeP.wqqdqoiE5PmVMP04>H$$xL*LHT>?hV_<-ip&IπU"o^?s_\/mcSggPul.&6I?'rLd/oaa]\lS?7^mP7o8l2_U9sALp'L+<G5lxSgQgliπU"T*SLmVhoHH,R<AP73+q#P\=vlRV1r7rTF<X+b\1r7mFPCP)S_[tf6PcnF/:P;I.πU"8(hVw1#IpF47F,H$ijnl5Wm$Wnc9HQ^(^sf_SaWG_.K:kfb.5,X-h35V+I$G(XKπU"Z2N-Oj-Rd7>V$jbhsP1$J])U;U*Y^je(DjgY(=3+Ova.xm_A(.P=nX[YZr4lFUiπU"pC$?8e?u#Cb4,6?ON]wVqVw/f;F+i$Ll3kO#],:#1)$;'Sfgc>5L:3mnnIPigOYπU"t[1aRFQ+>jAJaT>-feWXWN%NVsEf^1,A[6Hn=4]#w]mTekw.Msc0&rQL.rm%AqCπU"<$Ne*9gJ.nAbX<*n]p:R,:H($>B5$9R3H[%o4:a/;tF4KP[a.ojA=j;EG/v4_92πU"/3+]HEk3?4'>7\>J#UIE)\[Y<eo/)1X?A62of2)2=ePq7Y$5W('2kGV*/\5xHkxπU"3_x___?h4vNLugOakhHCnCaXHd/tL%O\cCmh37^WPE[B::4D&I1I0Qj\'3a92i]πU"a/?6H)C=[#Eh'7VG^Z')f%DSu8A5>d/.J8KhU>4W('?Y(Q=R?s&CkmVC[8<WM3cπU"5HT,fO7nSdv,%*s5V9B'-c.,J/MZ\EA82jj\a-[aepprUa5h_xFC=WM\=d_oS;iπU"9:]DV'q2#&eP^/+M\F4(U;>Ok\[S\KC:n7*V7O]OhBBa/m%atItt$\>6Z'w9XONπU");YFGVlCZF:E8VD_b6\]=lfbD9+nR:\)T3EVDE7$=4nwEiQ>\S]Ag.B7AX0G/XuπU"F05MR1dogwnQZi6O+j1FM#S_2CFGaqoa.32Wzqq\wEA;52IlIV1F*c[;8ib^Y=5πU"_5rTS8m0B6[SG,KK&X3nR7h&jd'3<8OmF-$9dlXhUr+i9SwLY(NMS.yK;l7JU*9πU"0U>ijp/Ya<Wq\.w&rCA6(A2j?TNC42&H1A1Sjn5%Wg7&M,KeFfRN8?k<FE['Pt9πU"'?jJc-BJkr;T0]p;Is=C5$eC+G[Dj6B\o%Cfh()hhS*U);Ok_gS$I()oO^[gU,?πU"sBar6hXr$ag'QmZ#nk?D^e-(Jt=1ewd++s$+kIYc^YMP3,QTaO;NSvPmdw9.8)xπU"eppYz^K+M$$8JoH#'$Oj)C#[MrO&gY<-P.cFAg[gm2_[>:%GL]YRW5ycup2uk]NπU"?:sO^:Od^Cc9<#c[F<t-iSVRT^J5#4H[8sW00z1I1G/Yh]H*4*dr><vs,w7n*tfπU";zUJ)%vQ,n_yLtd16ecFM#/5mxF?RIi4uqPOhAn\Ys\#=KU(YP2Rq*Etwj+e.ZqπU">*8x<WOf0Sti3:o4jdOW:;#AdItHSDvPE%.s3[_&y=2GfADPArCGI*nFP4ogfP2πU"rK&>%s(-+t,CsfrVL3n%vC&G-pU=:R\)GE/*[fIDd<<?_B2lRrp=3D;_bBp5,/[πU",$W;(J38P.HT6'FkE7?-*$gYXJKj?=i(Bp+C8LPJnm4(m=vLHB[aq;Iw=MkW1=MπU"[I\qQ+)B*S_=0,7-x\9B9,-hXF<Go**EO7'sx-,(\7oN$qU&&l4wcT0oNvBRd$CπU"=&tEv67TKQlyWN;I7nBvQc1i1[6oAKNYGc<i[#e(89T'ogRcE=zEI&)N;p+vPifπU";(V:-DpTr2>^'sdIJ7M<&0IE9<(U$#bJ9j$O#NpGza;m;oUlG.B3(Y+;RKu_>.qπU"AKC,p[bB.Rl0vWudT.ojp=9b)A$si2uM2up5trHr)I-t*^26<bpCS['eQl#<1gcπU"q1P8p'WsDG5mUo[11+UX4;deq3;J?fI^UWC7=t&2oXRj4BW#u>=.P_G1](ef:R&πU"5LOr#WXcem=bY/^8y_GdBg^V>,H'n,sb0aX$jk]o;G-Rt(1t(^LtGoGD$8s-P^*πU"%CYG8-H0>i7lE1;i4([Vp1q[TC.WNV);d)AEZXfx;VEYq0+[*_:eCARO+0;dQ\CπU"9dL*u=Pi%d[=gs&m:\m-V(Z=J;-,;/MbUCF]I?4VPG#470vEq?):m9JK$=;Yb0nπU"&)&)<wOK(;vVv'b$56<S?PX?1v?3HNwt$nJ)=?EjS-EjK1/<onL]15PP7sAiH^dπU"t<>btTZW/<_qz::R]3-b)HG?L<m[cIjSI\#.i'KM_+<[G'xNqY$*SAc8?=Vni2+πU"TpK#?BKh342:nTS^1wDbB((F7YE,r1bqRRFs]QR-&4z.VJ^8e_u?Z\/u7g3);4kπU"oQC:pB'Nb9C-'41Hi7VsIPGSI(22#FxMQ^jsUOxQyvFmlU_[6I4']-M(LNBDufoπU"hD)bS#wp)^toB[r*4h84zRrMjwMCu$e4ZGHe9lV9F3?#\-df18]ptnhF-o[1m4zπU"[Px$+hKj-EAKh2\si]b<B]sD2tNs'juq=I(?qf&3g4y$s=Mhpg\VYdvl42I&1G.πU";>l).J,mi;\1%m,JVeco0.;V?yK'u4xT<4h&UGY&eErg2s9C%N,7)0MLlA&L/TaπU"O#LrBS722s\CPK[aOZCJ&CyALWH[nl_]LGI0H>IOaXhjKRa(bQgR$n'IzsLf<lbπU"[fd/*(CAx&3T-M(ROS1oP;+Ru+/XPF7(<=mRU-tF\fHIG6*kyJzW5rSM4\LiXelπU"FG+UOqMZutqS6G7+x&B5$\k*S$Z8g8Qm6CqSy\($H(>krS(P't)b[i?e7r][h[gπU"82CyhL.D/DiP6?;>$n-y6F'J>CMAm+mZip<S&4q.^e#rxt0bLIA'xDup%()9%%%πU"%-%)qiAFp2XAN'6'%%'n)%%%.%%%&&twr%VSfs%xzyr,>T_595,ATiI4BC[J5QTπU"t8K_]/f]/CP-\o#&j)_vZKS[Z#i?I4sfx74Vs40URJmug=>GeO6B$b[rBvxKaZ8πU"tkHBVQ:$P1.Xg<CvT?Lv[dqG*vq0w/zl_G.aL+U&:njc\:W<7X>?Z=[^4rrk]goπU"uQB4c^<\;R:e8Db\I#T#_U#GYfSLJFRp-dTJ-CR0UotxtGa%KY*Yb-V8^oY)nV6πU"6L_,p<bd?OB](*TTI=?b-X>f[;iQ+i?uaZKJ<-xar_JQld+wq,p'R^aG/aC.PL<πU"G/:.:&N6:YGS(W6CYIWU$C-L3oC'$dEfc\uF+;2,^W+6]Ww/2kfED/S*QI986jmπU"^,Plq*/BC/C)Zjv:?MU=5Z-9iSshCu=F8eCnltZ<>CJ5'mvLr&*Qybk.vz&MKL^πU"w\U[eH50oiP=#rzHqX(Ng[]n9)e-%rDpSnKr&IoWj?bkL=$-#cLj$s:.d7:a%MBπU"EQ08#SA1sePtGK&'YMd/j&s4go;vm':zcsmPZ)E*1blZ0oY.=(c6[:\*3oc7/k=πU"g&%NaOEdKipHp)LTD&tp[7Zg7uIcmEl+'3/9PtMfm;_6;DLZaXLu&Cs(qq$5RmYπU"O+#6r;itBMNa<%'rHNaF_/AB=[Ge'EU<9i*Sl-2-d,H0fN+u)]Dljf6GO?(]esKπU".B<$.M']W+)jo2=mrIR.(-j/)4noQ\B)j43i%yQ&<J8Un<>tFrL;;3jJ]caS?9$πU"#;aIUT[TMmYJR(1aWL9?^EBqx#8A8NdMF]oqRD]2U&eo[rR)SIHO1Q((YUV1si[πU"tQ>Z])7APM=7Q29HAaw=g2^OK]wkAgN5F,P(t1Xb_[>Yd8,E:CFa03#e##[Zw.bπU"H85iUZ)AWRR>*51E$-[Fr8RZ^T*Osbd't2up%()9%%%%-%)siAFF[lio'T'%%%=πU"*%%%.%%%&&twr%WSfs[xzy:,=T]995<a<BaW^<#'=k;;v8,bD8,ZA-P*(pXjOIXπU"N*7Zw(iInOkUxMXJrQtJh_/blQ_Fjpd=:F0#ryqNEIB\^tYT(,1nbv.hm1ILJ:VπU"^fMG(>msW%8\_nGjDJSrr1skH]dY;O5sq#]fsULq;LBu5:<eeI'(T9YRK/bIzdAπU"xr//2:)ky,,<n.)PRzJBEC$:Dkb3J)4lDHN(sr<jPZJ?go16%5e->Y(FLJa1?0NπU"jW>vMVP,fT1o9=P-G??n)Yxxi?:LHm5:L#7>4xxm6F,nK0&;nJU^?vofCOk)X]lπU"KOglLP%NpJ-Hi<$rK,.M2NWVwtpp*DF;pXg]97EF8ibD$c7lPu3<C)gvTh.A:nnπU"T)Zfpmg+Ls\iy,1LxtC[I[brJ$(2\Gbu.]-X)<W'2cAvo/%;sl<>f-(=h29lPA1πU"S53KR^Hm-7PF3sNCL&EM=lT>($J]Dft3tWLqrL^(4GUnbN_+Z$ct-PdQfh[fG2=πU"i7?KZrd$1Nr\1nRq]pGNHlgj<Ec:oP9rjl:H)a>)4fg]OL[Gc3;U#hH]gMEVA[>πU"mhgvxkQ%w/tWMr9Mjy4.+)SOXRcFRXgrrniCA7Sj&_54^3iu;D9QLEb(N3$\;h-πU"ttFOCC1::f8PbUH6?q>wL8R)6BbA*9jsoM_Nodl9:IhB;f2#*8zC=C2TB_'qBjGπU"G(NL]i[mr15>+K8?$B\;Nb1d6k;j6/X]l;I<ipf>ZDwMAf3wbF>2]o1k>)&]L3nπU"S%-hE#ji<Uj'aZ.IGsTbn>8d#e,k\6\<tvsFiRL[)+;KNp#]PY5TB*8?d$%^ivXπU"e2n[.\y*p0$'u75>+f5^A?b,pQRT($?&<<CT&efP^K25Pjk0lOsQzVC^HZ<Am\nπU"egF-<jYF+^R>h^jKc#lWWgS%^ZMQI[n2azzPFO]$<WCfS<Zlj<N%up&'%9%9%%%πU"%-%(LjAFAHn]<&G.%%'$=%%%-%%%%%%%%%&%E%%%%%%.%%&t%wrSg%fxup%&'9%πU"%9%%%I-%qi#AF2X?AN6'7%%n)%%%.%%%%%%%%%&%%E%%%&m.%%&&twr%VSfs%xuπU"p&%'9%9%%%%-1%siA7F[li,oT'%%%=*%%%.%%%%%%%%%&%E#%%%Q#1%%&%twrW%πU"Sfsx%up*+%%%%%%(%(%&s%%%&S4%%%%%πEND SUBπCLOSE:IF S=195AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπRichard Hilsden                FEDERATION DEFENDER            [e-mail]           08-29-96 (10:17)       QB, QBasic, PDS        1068 32378    FED-DEF.BAS 'Welcome To federation Defender This is Version 1.01π'1.0 Was Almost the same Exepet it was way to easy soπ'I made It alot harder (Still a bit too easy)π'This happends to be my first Game that I have madeπ'And I hope you think its good most of my friends sayπ'It's fine but the don't like the control Oh well.π'Ya there Are a few gliches And in the next verion Iπ'should have them all fixed. You may say My code Isπ'veary messy Well that's because I've only been programingπ'for 2 Months.  I hope you enjoy itππDECLARE SUB LostGame ()πDECLARE SUB BeatGame ()πDECLARE SUB Center0 (Row!, Text$, c!)πDECLARE SUB TheStory ()πDECLARE SUB Center (Row, Text$, c)πDECLARE SUB Game1 ()πDECLARE SUB Pacman ()πDECLARE SUB BigD ()πDECLARE SUB Bye ()πDECLARE SUB DrawBye ()πDIM dot(1000)πCLEAR , , 20005ππSCREEN 12πGameEnd% = 0πpacx = 320πpacy = 225πs% = 0πCONST ArraySize = 242, NumGraphics = 21πCONST Delay = 700πCONST True = -1, False = NOT TrueπDIM Graphic(0 TO ArraySize * NumGraphics)πBigDπCLEAR , , 20005πPacmanπCLEAR , , 20005ππCount% = 2πSCREEN 13π2πCLEAR , , 20005πON PLAY(1) GOSUB MuchMusicπdoth% = 75πCLSπCOLOR 15πCIRCLE (210, 120), 4, 7             'dotπPAINT (210, 120), 4, 7πGET (220, 145)-(200, 95), dotπCLSπ3πππLINE (62, 10)-(230, 70), 0, BFπLINE (62, 10)-(230, 70), 12, BπLINE (61, 9)-(231, 71), 4, BπLINE (60, 8)-(232, 72), 7, BπCOLOR 15: LOCATE 5, 10: PRINT "F": PLAY "l30n0"πCOLOR 2: LOCATE 5, 10: PRINT "F": COLOR 15: LOCATE 5, 11: PRINT "e": PLAY "l30n0"πCOLOR 2: LOCATE 5, 11: PRINT "e": COLOR 15: LOCATE 5, 12: PRINT "d": PLAY "l30n0"πCOLOR 2: LOCATE 5, 12: PRINT "d": COLOR 15: LOCATE 5, 13: PRINT "e": PLAY "l30n0"πCOLOR 2: LOCATE 5, 13: PRINT "e": COLOR 15: LOCATE 5, 14: PRINT "r": PLAY "l30n0"πCOLOR 2: LOCATE 5, 14: PRINT "r": COLOR 15: LOCATE 5, 15: PRINT "a": LOCATE 17, 15: PRINT "E": LOCATE 15, 15: PRINT "S": LOCATE 13, 15: PRINT "P": PLAY "l30n0"πCOLOR 2: LOCATE 5, 15: PRINT "a": LOCATE 17, 15: PRINT "E": LOCATE 15, 15: PRINT "S": LOCATE 13, 15: PRINT "P": COLOR 15: LOCATE 5, 16: PRINT "t": LOCATE 17, 16: PRINT "x": LOCATE 15, 16: PRINT "t": LOCATE 13, 16: PRINT "l": PLAY "l30n0"πCOLOR 2: LOCATE 5, 16: PRINT "t": LOCATE 17, 16: PRINT "x": LOCATE 15, 16: PRINT "t": LOCATE 13, 16: PRINT "l": COLOR 15: LOCATE 5, 17: PRINT "i": LOCATE 17, 17: PRINT "i": LOCATE 15, 17: PRINT "o": LOCATE 13, 17: PRINT "a": PLAY "l30n0"πCOLOR 2: LOCATE 5, 17: PRINT "i": LOCATE 17, 17: PRINT "i": LOCATE 15, 17: PRINT "o": LOCATE 13, 17: PRINT "a": COLOR 15: LOCATE 5, 18: PRINT "o": LOCATE 17, 18: PRINT "t": LOCATE 15, 18: PRINT "r": LOCATE 13, 18: PRINT "y": PLAY "l30n0"πCOLOR 2: LOCATE 5, 18: PRINT "o": LOCATE 17, 18: PRINT "t": LOCATE 15, 18: PRINT "r": LOCATE 13, 18: PRINT "y": COLOR 15: LOCATE 5, 19: PRINT "n": LOCATE 15, 19: PRINT "y": PLAY "l30n0"πCOLOR 2: LOCATE 5, 19: PRINT "n": LOCATE 15, 19: PRINT "y": PLAY "l30n0"πCOLOR 15: LOCATE 5, 21: PRINT "D": PLAY "L30n0"πCOLOR 2: LOCATE 5, 21: PRINT "D": COLOR 15: LOCATE 5, 22: PRINT "e": PLAY "l30n0"πCOLOR 2: LOCATE 5, 22: PRINT "e": COLOR 15: LOCATE 5, 23: PRINT "f": PLAY "l30n0"πCOLOR 2: LOCATE 5, 23: PRINT "f": COLOR 15: LOCATE 5, 24: PRINT "e": PLAY "l30n0"πCOLOR 2: LOCATE 5, 24: PRINT "e": COLOR 15: LOCATE 5, 25: PRINT "n": PLAY "l30n0"πCOLOR 2: LOCATE 5, 25: PRINT "n": COLOR 15: LOCATE 5, 26: PRINT "d": PLAY "l30n0"πCOLOR 2: LOCATE 5, 26: PRINT "d": COLOR 15: LOCATE 5, 27: PRINT "e": PLAY "l30n0"πCOLOR 2: LOCATE 5, 27: PRINT "e": COLOR 15: LOCATE 5, 28: PRINT "r": PLAY "l30n0"πCOLOR 2: LOCATE 5, 28: PRINT "r"πPUT (90, doth%), dot, PSETπPLAY ONπMBuff$ = "T150L2O3CGP16L16FEDL2>C<GP16L16FEDL2>C<GP16L16FEFL2D"πPLAY "MB X" + VARPTR$(MBuff$)ππ1πhe:πDOπSELECT CASE INKEY$πCASE IS = CHR$(0) + "H": GOSUB upπCASE IS = CHR$(0) + "P": GOSUB downπCASE IS = CHR$(13): GOSUB reternπEND SELECTπGOTO 1πdown:πFOR repeat = 1 TO 3πIF doth% < 105 THENπdoth% = doth% + 5πEND IFπNEXT repeatπPUT (90, doth%), dot, PSETπRETURNπup:πFOR repeat = 1 TO 3πIF doth% > 75 THENπdoth% = doth% - 5π'v% = v% - 1πEND IFπNEXTπPUT (90, doth%), dot, PSETπGOTO 1πLOOP UNTIL INKEY$ = CHR$(27)πretern:πIF doth% = 75 THEN CLEAR , , 20005: CALL Game1: CLEAR , , 20005: GOTO 2πIF doth% = 90 THEN CLEAR , , 20005: CALL TheStory: CLEAR , , 20005: GOTO 2πIF doth% = 105 THENπEND IFπSCREEN 12π'ByeπSYSTEMπMuchMusic:πCount% = Count% + 1πSELECT CASE Count%πCASE 0: MBuff$ = "T150L2O3CGP16L16FEDL2>C<GP16L16FEDL2>C<GP16L16FEFL2D"πCASE 1: MBuff$ = "P16L16<GGGL2>CGP32L16FEDL2>C<GP16L16FEDL2>C<GP16L16A+"πCASE 2: MBuff$ = "AA+L1GL2G.L8<G.L16GL4A.L8A>FEDCL16CDEDP16L8"πCASE 3: MBuff$ = "<AL4BL8G.L16G"πCASE 4: MBuff$ = "L4A.L8A>FEDCGP8L4D.P8L8<G.L16GL4A.L8A>FEDCL16"πCASE 5: MBuff$ = "CDEDP16L8<A"πCASE 6: MBuff$ = "L4BP16L8>G.L16GL8>C.L16<A+L8G+.L16GL8F.L16D+L8D.L16CL1G"πCASE 7: MBuff$ = "L2G.P16L16GGGL8>CP8L16<CCCL2C.": Count% = -1πEND SELECTπPLAY "MB X" + VARPTR$(MBuff$)πRETURNππSUB BeatGameπDIM Ship(900)πON PLAY(1) GOSUB MuchMusicπPLAY ONπMBuff$ = "T150L2O3CGP16L16FEDL2>C<GP16L16FEDL2>C<GP16L16FEFL2D"πPLAY "MB X" + VARPTR$(MBuff$)πg% = 400πx% = 288πStarNum% = 300πLNum% = 1πDIM StarX(StarNum%), StarY(StarNum%), Layer(LNum%)πLINE (10, 10)-(10, 20), 3π  LINE (10, 18)-(20, 15), 3π  LINE (25, 20)-(25, 10), 3π  LINE (25, 18)-(19, 15), 3π  LINE (18, 5)-(18, 15), 2πGET (31, 28)-(2, 1), ShipπCLSπFOR l = 1 TO LNum%πIF l = 1 THEN Layer(l) = 3πIF l = 2 THEN Layer(l) = 4πDO: k$ = "R": LOOP UNTIL k$ = "L" OR k$ = "R"πIF k$ = "L" THEN Layer(l) = -Layer(l)πPRINTπNEXT lπFOR I% = 1 TO StarNum%πStarX(I%) = (RND * 619) + 1πStarY(I%) = (RND * 599) + 1πNEXT I%ππDOπFOR I% = 1 TO StarNum%πPSET (StarX(I%), StarY(I%)), 0πIF I% > (StarNum% / LNum%) * CL THEN CL = CL + 1πStarX(I%) = StarX(I%) + Layer(CL)πIF StarX(I%) < 1 THEN StarX(I%) = 619: StarY(I%) = RND * 619πIF StarX(I%) > 599 THEN StarX(I%) = 1: StarY(I%) = RND * 599πc% = (CL * 4) + 19πPSET (StarX(I%), StarY(I%)), c%πNEXT I%πIF g% > 20 THENπFOR jkjkj% = 1 TO 3πg% = g% - 2.5πPUT (x%, g%), Ship, PSETπNEXT jkjkj%πEND IFπCOLOR 15: LOCATE 8, 10πPRINT "Thanks to you, The Nebulatic Army has been defeated. The Vanderbelt"πPRINT "       king gave you the medal of bravery for your boldness in the"πPRINT "       destruction of The Nebulatic race.  The galaxy is safe... "πPRINT ""πPRINT "                 -- At least For Now --"πLOOP WHILE INKEY$ = ""πIF g% > 20 THENπFOR jkjkj% = 1 TO 3πg% = g% - 2.5πPUT (x%, g%), Ship, PSETπNEXT jkjkj%πEND IFππEND SUBππSUB BigDπCLSπSCREEN 12πVIEW (0, 0)-(639, 479)πWINDOW (0, 0)-(200, 200)πDRAW "bl155r20d8l10g5d2r15d20g5l20u8r10e5u2l15u20e5br40"πPLAY "l4n0"πPLAY "l4n0"πDRAW "r15f5d30g5l15h5u30e5bf5bd1r5f2d24g2l5h2u24e2bu1bh5br35"πPLAY "l4n0"πDRAW "d40r10u10r10u10l10u10r15u10l25br40"πPLAY "l4n0"πDRAW "d10r8d30r9u30r8u10l25br40"πPLAY "l4n0"πDRAW "d40r5e8f8r5u40l10d10l5u10l10br40"πPLAY "l4n0"πDRAW "d40r10u10r5d10r10u40l25br10bd10d5r5u5l5bu10br30"πPLAY "l4n0"πDRAW "d40r10u10f10r5u5h15r10e5u10h5l20bf10bu5r5f3d3g3l5u9bd5bh10br40"πPLAY "l4n0"πDRAW "d40r25u10l15u5r10u10l10u5r15u10l25"πFOR I% = 0 TO 63πPALETTE 12, I%πLOCATE 6, 21πCOLOR 12πPRINT TAB(19); "╔════════╗ ╔════════╗ ╔════════╗ ╔╗      ╔╗"πPRINT TAB(19); "║╔═══════╝ ║╔══════╗║ ║╔══════╗║ ║║      ║║"πPRINT TAB(19); "║║         ║║      ║║ ║║      ║║ ║║      ║║"πPRINT TAB(19); "║╚═══╗     ║║      ║║ ║╚══════╝║ ║╚══════╝║"πPRINT TAB(19); "╚═══╗╚═══╗ ║║      ║║ ║ ╔══════╝ ║╔══════╗║"πPRINT TAB(19); "    ╚═══╗║ ║║      ║║ ║ ╚══╗     ║║      ║║"πPRINT TAB(19); "╔═══════╝║ ║╚══════╝║ ║╔══╗╚═══╗ ║║      ║║"πPRINT TAB(19); "╚════════╝ ╚════════╝ ╚╝  ╚════╝ ╚╝      ╚╝"πNEXT I%πPLAY "l64o6bagfedco5bagfedco4bagfedco3bagfedco2bagfedco1bagfedco0bagfedcl1n0"πCLSπEND SUBππSUB ByeπVIEW (0, 0)-(639, 479)πDOπIF flip% = 0 THENπflip% = 1πj% = 64πFOR I% = 0 TO 63 STEP 2πj% = j% - 2πPALETTE 6, j%πPALETTE 7, I%πLINE (0, 0)-(639, 479), 6, BFπCOLOR 7πDrawByeπNEXT I%πELSEπflip% = 0πj% = 64πFOR I% = 0 TO 63 STEP 2πj% = j% - 2πPALETTE 7, j%πPALETTE 6, I%πLINE (0, 0)-(639, 479), 6, BFπCOLOR 7πDrawByeπNEXT I%πEND IFπLOOP WHILE INKEY$ = ""πEND SUBππSUB Center (Row, Text$, c)πCOLOR cπLOCATE Row, 20 - (LEN(Text$) / 2)πPRINT Text$πCOLOR 15πEND SUBππSUB Center0 (Row, Text$, c)πCOLOR cπLOCATE Row, 40 - (LEN(Text$) / 2)πPRINT Text$πCOLOR 15πEND SUBππSUB DrawByeπLOCATE 15, 2: PRINT "████████████████": LOCATE 15, 33: PRINT "████████": LOCATE 15, 50: PRINT "████████████████"πLOCATE 14, 2: PRINT "████": LOCATE 14, 17: PRINT "███": LOCATE 14, 32: PRINT "████": LOCATE 14, 38: PRINT "████": LOCATE 14, 50: PRINT "████"πLOCATE 16, 2: PRINT "████████████████": LOCATE 16, 34: PRINT "██████": LOCATE 16, 50: PRINT "████████████████"πLOCATE 13, 2: PRINT "████": LOCATE 13, 17: PRINT "███████": LOCATE 13, 31: PRINT "████": LOCATE 13, 39: PRINT "████": LOCATE 13, 50: PRINT "████"πLOCATE 17, 2: PRINT "████": LOCATE 17, 17: PRINT "███": LOCATE 17, 35: PRINT "████": LOCATE 17, 50: PRINT "████"πLOCATE 12, 2: PRINT "████": LOCATE 12, 21: PRINT "███": LOCATE 12, 30: PRINT "████": LOCATE 12, 40: PRINT "████": LOCATE 12, 50: PRINT "████"πLOCATE 18, 2: PRINT "████": LOCATE 18, 17: PRINT "███████": LOCATE 18, 35: PRINT "████": LOCATE 18, 50: PRINT "████"πLOCATE 11, 2: PRINT "████": LOCATE 11, 21: PRINT "███": LOCATE 11, 29: PRINT "████": LOCATE 11, 41: PRINT "████": LOCATE 11, 50: PRINT "████"πLOCATE 19, 2: PRINT "████": LOCATE 19, 20: PRINT "████": LOCATE 19, 35: PRINT "████": LOCATE 19, 50: PRINT "████"πLOCATE 10, 2: PRINT "████": LOCATE 10, 18: PRINT "██████": LOCATE 10, 28: PRINT "████": LOCATE 10, 42: PRINT "████": LOCATE 10, 50: PRINT "████"πLOCATE 20, 2: PRINT "████": LOCATE 20, 20: PRINT "████": LOCATE 20, 35: PRINT "████": LOCATE 20, 50: PRINT "████"πLOCATE 9, 2: PRINT "███████████████████": LOCATE 9, 27: PRINT "████": LOCATE 9, 43: PRINT "████": LOCATE 9, 50: PRINT "██████████████████████"πLOCATE 21, 2: PRINT "████": LOCATE 21, 18: PRINT "██████": LOCATE 21, 35: PRINT "████": LOCATE 21, 50: PRINT "████"πLOCATE 8, 2: PRINT "████████████████": LOCATE 8, 26: PRINT "████": LOCATE 8, 44: PRINT "████": LOCATE 8, 50: PRINT "██████████████████████"πLOCATE 22, 2: PRINT "███████████████████": LOCATE 22, 35: PRINT "████": LOCATE 22, 50: PRINT "█████████████████████"πLOCATE 23, 2: PRINT "███████████████": LOCATE 23, 35: PRINT "████": LOCATE 23, 50: PRINT "█████████████████████"πEND SUBππSUB Game1πDIM Ship(900)πDIM Enemy(900)πDIM shot(800)πDIM Eshot(800)πRANDOMIZE TIMERπleveltoggle% = 1πlife% = 2πraguExtraChunky:π'Varable Settingsπetoggle% = 2πPeashooterFX$ = "l64o1cdefgabagfedc"πDrunkFX$ = "l64o1abababababo0cdcdcdcdcd"πHomingFX$ = "l64o1abo0cdo1abo0cdo1abo0cdo1abo0cdo1abo0cdo1ab"πLaserFX$ = "l64 o6bgec o5bgec o2be o0gc"πShotFX$ = "l64 o5ec o6bgec o5bgec o2bgec o0bgec"πex% = 30                                         'Enemy shot Left & rightπey% = 60                                         'Enemyshot up & downπg% = 312                                         'Up & Downπx% = 288                                         'Left & rightπrc% = 0πv% = 1πl% = 15                                          'Enemy up & downπr% = 20                                          'Enemy left & rightπd% = 30                                     'Shot up & downπf% = 60                                         'Shot left & rightπpee% = 0πts% = 800πMasterLeveltoggle% = 1πhit% = 0πEnemyLife% = 3πhitshot = 0πdie% = 0π'ewt% = RND * 3 + 1                               'Random EWTπIF leveltoggle% = 1 THENπewt% = 3                                        'Enemy Weapon Type:πELSEIF leveltoggle% = 2 THENπewt% = 2πELSEIF leveltoggle% = 3 OR leveltoggle% = 4 THENπewt% = 1πELSEIF leveltoggle% > 4 THENπewt% = 4πEnemyLife% = 4πELSEπewt% = 4πEND IFπ                                                 '1 = Class I laserπ                                                 '2 = Peashooterπ                                                 '3 = RS-1 "Drunk" torpedoπ                                                 '4 = RS-2 "Homing torpedoπSCREEN 12π                                                 'Enemy Shot Code:πPALETTE 14, 63πIF ewt% = 1 THENπLINE (2, 10)-(2, 45), 4                           'LaserπGET (1, 1)-(3, 50), Eshot                        'LaserπELSEIF Ewt2% = 1 THENπLINE (2, 10)-(2, 45), 4πGET (1, 1)-(3, 50), EshotπELSEIF ewt% = 3 OR ewt% = 4 OR Ewt2% = 1 THENπCIRCLE (210, 120), 3, 7                          'TorpedoesπELSEIF ewt% = 2 THENπCIRCLE (210, 120), 2, 7                          'PeashooterπPAINT (210, 120), 2, 7                           'PeashooterπEND IFπIF ewt% = 4 OR Ewt2% = 1 THENπPAINT (210, 120), 3, 7                           'Homing torpedoπELSEIF ewt% = 3 THENπPAINT (210, 120), 5, 7                           'Drunk torpedoπELSEπEND IFπIF ewt% = 2 OR ewt% = 3 OR ewt% = 4 OR Ewt2% = 1 THENπGET (220, 130)-(200, 110), Eshot                 'Everything but laserπELSEπEND IFπ'PUT (30, 50), Eshot, PSETπCLSππLINE (10, 10)-(10, 20), 3                        'This draws the shipπLINE (10, 18)-(20, 15), 3πLINE (25, 20)-(25, 10), 3πLINE (25, 18)-(19, 15), 3πLINE (18, 5)-(18, 15), 2πGET (31, 28)-(2, 1), ShipππPALETTE 14, 63                                   'This draws the enemyπCIRCLE (545, 120), 8, 7πPAINT (545, 120), 14, 7πGET (555, 130)-(535, 80), EnemyππSCREEN 12πLINE (2, 5)-(2, 40), 3                           'This draws the shotπGET (1, 70)-(2, 1), shotπPUT (30, 50), shot, PSETπCLSππLINE (15, 432)-(600, 15), 0, BFπLINE (11, 433)-(517, 11), 7, BππPUT (x%, g%), Ship, PSETππ7πIF k% = 2 THENπNew% = f% - 40πNew1% = 20πLINE (New%, New1%)-STEP(90, 90), 0, BFπPUT (x%, g%), Ship, PSETπk% = 0πEND IFπIF die% = 1 THENπdie% = 0πNew% = 520πNew1% = 100πLINE (New%, New1%)-STEP(50, 50), 0, BFπPUT (x%, g%), Ship, PSETπEND IFπIF Ek% = 1 THENπEnew% = ex%πEnew1% = ey%πLINE (Enew%, Enew1%)-STEP(30, 50), 0, BF: ex% = 30: ey% = 60: Ek% = 0πPUT (x%, g%), Ship, PSETπEND IFπCOLOR 15: LOCATE 2, 67: PRINT "  INFO BAR"      'The Change I made for the Info barπLOCATE 3, 66: PRINT "--------------"πLINE (541, 76)-(611, 90), 14, BFπLOCATE 7, 67: PRINT " Enemy Life"πLOCATE 10, 67: PRINT "  Lives:"; life%πDOππSELECT CASE INKEY$πCASE IS = CHR$(0) + "H": GOSUB RaiseπCASE IS = CHR$(0) + "P": GOSUB LowerπCASE IS = CHR$(0) + "K": GOSUB LeftπCASE IS = CHR$(0) + "M": GOSUB RightπCASE IS = " "πIF NOT k% = 1 THEN GOSUB fireπCASE IS = CHR$(27): GOSUB endingπEND SELECTππIF d% < 20 THEN d% = g% - 5: k% = 2πIF k% = 2 THEN d% = g% - 5πIF k% = 1 THEN GOTO 56πGOTO 23ππRaise:           π        IF g% > 90 THENπ        FOR l = 1 TO 2π        g% = g% - 4π        PUT (x%, g%), Ship, PSETπ        NEXTπ        END IFπ        PUT (x%, g%), Ship, PSETπ        RETURNπGOTO 23ππLower:π        IF g% < 370 THENπ        FOR l = 1 TO 2π        g% = g% + 4π        PUT (x%, g%), Ship, PSETπ        NEXTπ        END IFπ        PUT (x%, g%), Ship, PSETπ        RETURNπGOTO 23ππRight:π        IF x% < 480 THENπ        FOR l = 1 TO 2π        x% = x% + 4π        PUT (x%, g%), Ship, PSETπ        NEXTπ        END IFπ        PUT (x%, g%), Ship, PSETπ        RETURNπGOTO 23ππLeft:π        IF x% > 20 THENπ        FOR l = 1 TO 2π        x% = x% - 4π        PUT (x%, g%), Ship, PSETπ        NEXTπ        END IFπ        PUT (x%, g%), Ship, PSETπ        RETURNπGOTO 23ππovershot:πRETURNππfire:π        PLAY "MB X" + VARPTR$(ShotFX$)π        IF barreltoggle% = 0 THENπ        barreltoggle% = 1π        ELSEπ        barreltoggle% = 0π        END IFπ        IF fire% = 6 THEN GOSUB overshot:π        IF k% = 1 THEN GOTO 56π        fire% = fire% + 1π        d% = g% - 5π        f% = x%π        IF barreltoggle% = 0 THEN f% = f% + 26π        IF barreltoggle% = 1 THEN f% = f% + 4π        k% = 1π56π        IF d% < 20 THEN k% = 2: PRINT shot: GOTO 7π        d% = d% - 8π        PUT (f%, d%), shot, PSETπ        h% = f%π        hight% = d%π        hi% = r% + 38ππ        IF h% > hi% - 37 AND h% < hi% - 19 AND d% < 65 AND d% > 35 THENπ        hit% = hit% + 1: hitshot% = 1: d% = g% - 5: die% = 1π        END IFπ        IF hit% = EnemyLife% THENπ        GOSUB Ending2π        END IFπ        IF hit% = 2 AND hitshot% = 1 THENπ        hitshot% = 0π        k% = 2π        FOR I% = 46 TO 30 STEP -1π        PALETTE 14, I%π        PLAY "l32n0"π        FOR j% = 1 TO 30π        die% = 0π        New% = 520π        New1% = 100π        NEXT j%π        NEXT I%π        END IFπ        IF hit% = 3 AND hitshot% = 1 THENπ        hitshot% = 0π        k% = 2π        FOR I% = 30 TO 0 STEP -1π        PALETTE 14, I%π        PLAY "l32n0"π        FOR j% = 1 TO 30π        die% = 0π        New% = 520π        New1% = 100π        NEXT j%π        NEXT I%π        END IFπ        IF hit% = 1 AND hitshot% = 1 THENπ        hitshot% = 0π        k% = 2π        FOR I% = 63 TO 46 STEP -1π        PALETTE 14, I%π        PLAY "l32n0"π        FOR j% = 1 TO 30π        die% = 0π        New% = 520π        New1% = 100π        NEXT j%π        NEXT I%π        END IFπ        GOSUB 23πLOOP UNTIL INKEY$ = CHR$(27)ππ23                                               'Enemy AIπ        PUT (r%, l%), Enemy, PSETπIF v% = 1 THEN GOTO 76πIF v% = 2 THEN GOTO 67ππ76π        IF r% > 20 OR r% < 480 THENπ        r% = r% + 2π        PUT (r%, l%), Enemy, PSETπ        END IFπ        IF r% = 480 THEN v% = 2π        IF ewt% = 1 THENπ        IF x% < r% - 6 AND x% > r% - 14 THEN Eshot% = 1    'Laserπ        ELSEπ        IF leveltoggle% < 5 THEN cool% = RND * 200                                  'Random, everything but laserπ        IF leveltoggle% = 5 THEN cool% = RND * 100π        IF cool% = 7 THEN Eshot% = 1                       'Random, everything but laserπ        'cool% = cool% + 1                                 'Everything but laserπ        'IF cool% = 200 THEN Eshot% = 1                    'Everything but laserπ        END IFπ        IF Eshot% = 1 THEN GOSUB Enemyshot                 'EverythingπGOTO 7ππ67π        IF r% > 20 THENπ        r% = r% - 2π        PUT (r%, l%), Enemy, PSETπ        END IFπ        IF r% = 24 THEN v% = 1π        IF r% = 400 THEN v% = 2π        IF ewt% = 1 THENπ        IF x% < r% - 6 AND x% > r% - 14 THEN Eshot% = 1  'Laserπ        ELSEπ        cool% = RND * 200                                  'Random, everything but laserπ        IF cool% = 7 THEN Eshot% = 1                       'Random, everything but laserπ        'cool% = cool% + 1                               'Everything but laserπ        'IF cool% < 200 THEN Eshot% = 0                  'Everything but laserπ        'IF cool% = 200 THEN Eshot% = 1                  'Everything but laserπ        END IFπ        IF Eshot% = 1 THEN GOSUB Enemyshot               'EverythingπGOTO 7ππending:πPRINT "Do You Want To Exit Y/N"πA$ = UCASE$(INPUT$(1))πIF A$ = "N" THEN GOTO 7πIF A$ = "Y" THEN GOTO 10 ELSE GOSUB endingππEnding2:πDOπrc% = rc% + 1πrr% = RND * 20 + r%πrl% = RND * 20 + l% + 30πPSET (rr%, rl%), 0πLOOP UNTIL rc% = 600πCLSπFOR I% = 1 TO 63πPALETTE 10, I%πLOCATE 10, 20πCOLOR 10πPRINT TAB(21); "╔═════════════════════════════════╗"πPRINT TAB(21); "║                                 ║"πPRINT TAB(21); "║    You have beaten level"; leveltoggle%; "!!!  ║"πPRINT TAB(21); "║                                 ║"πPRINT TAB(21); "╚═════════════════════════════════╝"πNEXT I%πPLAY "l2n0"πKeyy$ = UCASE$(INPUT$(1))πFOR d% = 63 TO 1 STEP -1πPALETTE 10, d%πLOCATE 10, 20πCOLOR 10πPRINT TAB(21); "╔═════════════════════════════════╗"πPRINT TAB(21); "║                                 ║"πPRINT TAB(21); "║    You have beaten level"; leveltoggle%; "!!!  ║ "πPRINT TAB(21); "║                                 ║"πPRINT TAB(21); "╚═════════════════════════════════╝"πNEXT d%πIF leveltoggle% = 7 THENπBeatGame: GOTO 10πELSE leveltoggle% = leveltoggle% + 1: GOTO raguExtraChunkyπEND IFπEnemyshot:πIF loser% = 4 THEN GOTO winnerπloser% = 4πIF ewt% = 1 THENπPLAY "MB X" + VARPTR$(LaserFX$)                  'LaserπELSEIF ewt% = 2 THENπPLAY "MB X" + VARPTR$(PeashooterFX$)             'PeashooterπELSEIF ewt% = 3 THENπPLAY "MB X" + VARPTR$(DrunkFX$)                  'Drunk torpedoπELSEIF ewt% = 4 THENπPLAY "MB X" + VARPTR$(HomingFX$)                 'Homing missileπEND IFπex% = r%πIF ewt% = 2 THENπee% = (x% - r%) / 150                            'Peashooterπef% = (g% - l%) / 150                            'PeashooterπELSEπEND IFπab = 100πwinner:πIF etoggle% = 1 THENπetoggle% = 2πELSEIF etoggle% = 2 THENπetoggle% = 0πELSEπetoggle% = 1πEND IFπIF etoggle% = 1 OR etoggle% = 2 THEN ec% = 4πIF etoggle% = 0 THEN ec% = 0πIF loser% = 0 THEN ec% = 0πIF etoggle% = 0 THENπFOR s% = 1 TO 2πab = ab - .5πIF ab < 14 THEN EXIT FORπIF ewt% = 4 THENπee% = (x% - ex%) / ab                            'Homing torpedoπef% = (g% - ey%) / ab                            'Homing torpedo > the first IF a few lines down is also homingπELSEIF ewt% = 3 THENπee% = (x% - r%) / 150                            'Drunk torpedoπef% = (g% - l%) / 150                            'Drunk torpedoπELSEIF ewt% = 1 THENπee% = 0                                          'Laser > the third IF is everything but laserπef% = 8                                          'Laser > the fourth IF is laserπELSEπEND IFπIF leveltoggle% = 4 THENπFOR hilow% = 1 TO 2πex% = ex% + ee%πey% = ey% + ef%πPUT (ex%, ey%), Eshot, PSETπNEXT hilow%πELSEπex% = ex% + ee%πey% = ey% + ef%πPUT (ex%, ey%), Eshot, PSETπEND IFπNEXT s%πloser% = 4πIF ab < 12 OR ey% > 360 OR ex% < 25 OR ex% > 475 THEN etoggle% = 0: loser% = 0: Eshot% = 0: cool% = 0: Ek% = 1πIF ewt% = 2 OR ewt% = 3 OR ewt% = 4 THENπIF ex% > x% - 10 AND ex% < x% + 22 AND ey% > g% - 15 AND ey% < g% + 10 THEN GOTO 777πELSEπIF ex% > x% AND ex% < x% + 22 AND ey% > g% - 38 AND ey% < g% + 10 THEN GOTO 777πEND IFπEND IFπGOTO 7π777 :πIF ewt% = 1 THENπLINE (x% - 55, g% - 55)-(x% + 45, g% + 45), 0, BFπELSEπLINE (x% - 15, g% - 15)-(x% + 45, g% + 45), 0, BFπEND IFπDOπIF q% = 0 THENπq% = 1: c% = 4πELSEIF q% = 1 THENπq% = 2: c% = 4πELSEIF q% = 2 THENπq% = 0: c% = 15πEND IFπpee% = pee% + 1πCIRCLE (x% + 15, g% + 15), 15, 7πPAINT (x% + 15, g% + 15), c%, 7πLOOP UNTIL pee% = 150πDOπrc% = rc% + 1πrx% = RND * 40 + x%πrg% = RND * 40 + g%πPSET (rx%, rg%), 0πLOOP UNTIL rc% = 8000πCLSπlife% = life% - 1πIF life% < 0 THENπFOR I% = 1 TO 63πPALETTE 10, I%πLOCATE 10, 20πCOLOR 10πPRINT TAB(21); "╔═════════════════════════════════╗"πPRINT TAB(21); "║                                 ║"πPRINT TAB(21); "║    ): You have been killed :(   ║"πPRINT TAB(21); "║                                 ║"πPRINT TAB(21); "╚═════════════════════════════════╝"πNEXT I%πPLAY "l2n0"πKeyy$ = UCASE$(INPUT$(1))πFOR d% = 63 TO 1 STEP -1πPALETTE 10, d%πLOCATE 10, 20πCOLOR 10πPRINT TAB(21); "╔═════════════════════════════════╗"πPRINT TAB(21); "║                                 ║"πPRINT TAB(21); "║    ): You have been killed :(   ║"πPRINT TAB(21); "║                                 ║"πPRINT TAB(21); "╚═════════════════════════════════╝"πNEXT d%πLostGameπGOTO 10πELSEπGOTO raguExtraChunkyπEND IFπ10πSCREEN 13πEND SUBππSUB LostGameπDIM Ship(900)πg% = 400πx% = 288πTaps$ = "o2l2cl4cl1fl2cl4fl1al2cl4facfacfl1al2al4al1o3co2l2al4fl1cl2cl4cl1f"πStarNum% = 300πLNum% = 1πDIM StarX(StarNum%), StarY(StarNum%), Layer(LNum%)πLINE (10, 10)-(10, 20), 3π  LINE (10, 18)-(20, 15), 3π  LINE (25, 20)-(25, 10), 3π  LINE (25, 18)-(19, 15), 3π  LINE (18, 5)-(18, 15), 2πGET (31, 28)-(2, 1), ShipππCLSπFOR l = 1 TO LNum%πIF l = 1 THEN Layer(l) = 3πIF l = 2 THEN Layer(l) = 4πDO: k$ = "R": LOOP UNTIL k$ = "L" OR k$ = "R"πIF k$ = "L" THEN Layer(l) = -Layer(l)πPRINTπNEXT lπPLAY "MB X" + VARPTR$(Taps$)πFOR I% = 1 TO StarNum%πStarX(I%) = (RND * 619) + 1πStarY(I%) = (RND * 599) + 1πNEXT I%ππDOπFOR I% = 1 TO StarNum%πPSET (StarX(I%), StarY(I%)), 0πIF I% > (StarNum% / LNum%) * CL THEN CL = CL + 1πStarX(I%) = StarX(I%) + Layer(CL)πIF StarX(I%) < 1 THEN StarX(I%) = 619: StarY(I%) = RND * 619πIF StarX(I%) > 599 THEN StarX(I%) = 1: StarY(I%) = RND * 599πc% = (CL * 4) + 19πPSET (StarX(I%), StarY(I%)), c%πNEXT I%πIF g% > 20 AND boom% = 0 THENπFOR jkjkj% = 1 TO 3πg% = g% - 2.5πPUT (x%, g%), Ship, PSETπNEXT jkjkj%πEND IFπIF g% < 50 AND boom% = 0 THENπDOπIF q% = 0 THENπq% = 1: c% = 4πELSEIF q% = 1 THENπq% = 2: c% = 4πELSEIF q% = 2 THENπq% = 0: c% = 15πEND IFπpee% = pee% + 1πCIRCLE (x% + 15, g% + 15), 15, 7πPAINT (x% + 15, g% + 15), c%, 7πLOOP UNTIL pee% = 150πDOπrc% = rc% + 1πrx% = RND * 40 + x%πrg% = RND * 40 + g%πPSET (rx%, rg%), 0πLOOP UNTIL rc% = 8500πboom% = 1πEND IFπππCOLOR 15: LOCATE 8, 10πPRINT "I am disappointed with your utter failure in the Nebulatic battle."πPRINT "       I've seen janitors do better (Space Quest, Moron). In World War II,"πPRINT "       a bad pilot was considered a dead one. Guess where that puts you on"πPRINT "       the top ten list!"πPRINT ""πPRINT "                                   Press <ESC> To Continue"πLOOP UNTIL INKEY$ = CHR$(27)πIF g% > 20 THENπFOR jkjkj% = 1 TO 3πg% = g% - 2.5πPUT (x%, g%), Ship, PSETπNEXT jkjkj%πEND IFπGameEnd% = 1πEND SUBππSUB PacmanπSCREEN 12πDIM Ship(900)πDIM shot(800)πLINE (10, 10)-(10, 20), 3                        'This draws the shipπLINE (10, 18)-(20, 15), 3πLINE (25, 20)-(25, 10), 3πLINE (25, 18)-(19, 15), 3πLINE (18, 5)-(18, 15), 2πGET (31, 28)-(2, 1), ShipπCLSπLINE (2, 5)-(2, 40), 3πGET (1, 70)-(2, 1), shotπCLSπbarney$ = "o2l6gel3gl6gel3gl6ao2l6gel3gl6gel3gl6a"πpacx = 320πpacy = 240πh% = 420πg% = 420πx% = 320πs% = 0πCONST ArraySize = 242, NumGraphics = 21πCONST Delay = 700πCONST True = -1, False = NOT TrueπDIM Graphic(0 TO ArraySize * NumGraphics)πGOSUB MakeDataπCLSπPLAY "MB X" + VARPTR$(barney$)πDOπFOR Frame = 0 TO 6 STEP 2πPUT (pacx, pacy), Graphic(Frame * ArraySize), PSETπFOR Stall = 0 TO Delay: NEXTπIF pacx < 384 THEN pacx = pacx + 3πNEXTπIF pacx > 195 AND pacx < 225 THEN GOSUB xwingπIF pacx > 225 THEN GOSUB firingπFOR Frame = 6 TO 0 STEP -2πPUT (pacx, pacy), Graphic(Frame * ArraySize), PSETπFOR Stall = 0 TO Delay: NEXTπIF pacx < 386 THEN pacx = pacx + 3πNEXTπIF pacx > 195 AND pacx < 225 THEN GOSUB xwingπIF pacx > 225 THEN GOSUB firingπIF pacx = 386 THEN NumTurns = 0πIF pacx = 10 OR pacy = 10 THENπs% = s% + 1πLOCATE 1, 8: PRINT s%πEND IFπIF pacx > 195 AND pacx < 225 THEN GOSUB xwingπIF pacx > 225 THEN GOSUB firingπLOOPπGOTO endsπMakeData:πFOR pacx = 1 TO 10πCIRCLE (20, 20), pacx, 14πCIRCLE (21, 20), pacx, 14πNEXT pacxπLINE (20, 14)-STEP(2, 1), 0, BFπGOSUB SaveGraphicπLINE (20, 20)-(31, 20), 0πGOSUB SaveGraphicπLINE (20, 20)-(31, 19), 0πLINE (20, 20)-(31, 21), 0πGOSUB SaveGraphicπLINE (20, 20)-(31, 18), 0πLINE (20, 20)-(31, 22), 0πGOSUB SaveGraphicπLINE (20, 20)-(31, 17), 0πLINE (20, 20)-(31, 23), 0πGOSUB SaveGraphicπLINE (20, 20)-(31, 16), 0πLINE (20, 20)-(31, 24), 0πGOSUB SaveGraphicπLINE (20, 20)-(31, 15), 0πLINE (20, 20)-(31, 25), 0πGOSUB SaveGraphicπSaveGraphic:πGET (6, 11)-(32, 29), Graphic(Offset)πOffset = Offset + ArraySizeπRETURNπxwing:πIF tea% = 1 THEN GOTO teeπtea% = 1πGOSUB MMusicπtee:πIF g% > 360 THENπFOR l = 1 TO 2πg% = g% - 4πPUT (x%, g%), Ship, PSETπNEXTπEND IFπPUT (x%, g%), Ship, PSETπRETURNπfiring:πIF h% < 255 THEN GOTO endsπIF tick% = 1 THEN GOTO tickeπtick% = 1πh% = g% + 12πticke:πh% = h% - 15πPUT (x%, h%), shot, PSETπRETURNπMMusic:πCount% = Count% + 1πMBuff$ = "T150L2O2CGP16L16FEDL2>C<GP16L16FEDL2>C<GP16L16FEFL2D"πPLAY "MB X" + VARPTR$(MBuff$)πRETURNπends:πCIRCLE (320, 240), 40, 12πDRAW "P4,12"πDRAW "BM0,0 P8,12"πFOR I = 2 TO 100πCIRCLE (320, 240), I, 14πCIRCLE (320, 240), I, 0πNEXT IπFOR I = 100 TO 410π'IF i = 290 THEN GOSUB MMusicπCIRCLE (320, 240), I, 14πCIRCLE (320, 240), (I - 99) * 2, 15πCIRCLE (320, 240), I - 2, 0πCIRCLE (320, 240), ((I - 99) * 2) - 2, 0πNEXT IπEND SUBππSUB TheStoryπSCREEN 12πCLSπA% = 25πk% = 25πStarNum% = 150πLNum% = 2πDIM StarX(StarNum%), StarY(StarNum%), Layer(LNum%)πFOR l = 1 TO LNum%πIF l = 1 THEN Layer(l) = 3πIF l = 2 THEN Layer(l) = 4πDO: k$ = "R": LOOP UNTIL k$ = "L" OR k$ = "R"πIF k$ = "L" THEN Layer(l) = -Layer(l)πPRINTπNEXT lπ'PLAY ONπ'PRINT "Music? [Y/N]";π'WHILE A$ <> "Y" AND A$ <> "N": A$ = "Y": WENDπ'IF A$ = "Y" THEN MBuff$ = "T150L2O3CGP16L16FEDL2>C<GP16L16FEDL2>C<GP16L16FEFL2D"π'PLAY "MB X" + VARPTR$(MBuff$)πSCREEN 12πFOR I% = 1 TO StarNum%πStarX(I%) = (RND * 619) + 1πStarY(I%) = (RND * 599) + 1πNEXT I%πDOππIF A% > 1 THENπA% = A% - 1πLOCATE A%, 25: PRINT "Federation Defender"πB% = A% + 1πLOCATE B%, 25: PRINT "                                  "πEND IFπIF A% < 2 THENπLOCATE A%, 25: PRINT "                                  "πIF s% = 0 THENπLOCATE 10, 1πA$ = "     You are the defender of a long time war galaxy. You must defeat the"πB$ = "evil aliens from planet Nebulats. Until now, the nebulatic creatures have"πc$ = "been winning the war, but now the planet Vanderbet (your home planet) is"πd$ = "launching an all-out strike against them. You are the Alpha leader, and"πe$ = "your job is to defeat the front lines of the Nebulatic army. Your ship"πf$ = "is equipped with Class III Lasers, but can interface with Nebulatic"πg$ = "weapons."πh$ = "Press <Spacebar> To Continue"πFOR w = 1 TO LEN(A$): SOUND 200, .1: LOCATE 10, 4: PRINT LEFT$(A$, w): FOR q = 1 TO 500: NEXT q: NEXTπFOR w = 1 TO LEN(B$): SOUND 200, .1: LOCATE 11, 4: PRINT LEFT$(B$, w): FOR q = 1 TO 500: NEXT q: NEXTπFOR w = 1 TO LEN(c$): SOUND 200, .1: LOCATE 12, 4: PRINT LEFT$(c$, w): FOR q = 1 TO 500: NEXT q: NEXTπFOR w = 1 TO LEN(d$): SOUND 200, .1: LOCATE 13, 4: PRINT LEFT$(d$, w): FOR q = 1 TO 500: NEXT q: NEXTπFOR w = 1 TO LEN(e$): SOUND 200, .1: LOCATE 14, 4: PRINT LEFT$(e$, w): FOR q = 1 TO 500: NEXT q: NEXTπFOR w = 1 TO LEN(f$): SOUND 200, .1: LOCATE 15, 4: PRINT LEFT$(f$, w): FOR q = 1 TO 500: NEXT q: NEXTπFOR w = 1 TO LEN(g$): SOUND 200, .1: LOCATE 16, 4: PRINT LEFT$(g$, w): FOR q = 1 TO 500: NEXT q: NEXTπCOLOR 14: SOUND 440, 1: FOR q = 1 TO 500: NEXT qπFOR w = 1 TO LEN(h$): SOUND 240 + w, 1: LOCATE 17, 46: PRINT LEFT$(h$, w): FOR q = 1 TO 500: NEXT q: NEXTπPRINT "                                                                                                 "πs% = 1πEND IFπEND IFπIF s% = 2 THENπLOCATE 10, 1: PRINT "                                                                                                            "πPRINT "                                                                                                                         "πPRINT "                                                                                                                    "πPRINT "                                                                                                                  "πPRINT "                                                                                                                       "πLOCATE 16, 20: PRINT " The Story is not done              "πEND IFπCL = 1πFOR I% = 1 TO StarNum%πPSET (StarX(I%), StarY(I%)), 0πIF I% > (StarNum% / LNum%) * CL THEN CL = CL + 1πStarX(I%) = StarX(I%) + Layer(CL)πIF StarX(I%) < 1 THEN StarX(I%) = 619: StarY(I%) = RND * 619πIF StarX(I%) > 599 THEN StarX(I%) = 1: StarY(I%) = RND * 599πc% = (CL * 4) + 19πPSET (StarX(I%), StarY(I%)), c%πNEXT I%πPLAY ONπLOOP UNTIL INKEY$ = " "πGOTO 28ππ'MuchMusic:πCount% = Count% + 1πSELECT CASE Count%πCASE 0: MBuff$ = "T150L2O3CGP16L16FEDL2>C<GP16L16FEDL2>C<GP16L16FEFL2D"πCASE 1: MBuff$ = "P16L16<GGGL2>CGP32L16FEDL2>C<GP16L16FEDL2>C<GP16L16A+"πCASE 2: MBuff$ = "AA+L1GL2G.L8<G.L16GL4A.L8A>FEDCL16CDEDP16L8"πCASE 3: MBuff$ = "<AL4BL8G.L16G"πCASE 4: MBuff$ = "L4A.L8A>FEDCGP8L4D.P8L8<G.L16GL4A.L8A>FEDCL16"πCASE 5: MBuff$ = "CDEDP16L8<A"πCASE 6: MBuff$ = "L4BP16L8>G.L16GL8>C.L16<A+L8G+.L16GL8F.L16D+L8D.L16CL1G"πCASE 7: MBuff$ = "L2G.P16L16GGGL8>CP8L16<CCCL2C.": Count% = -1πEND SELECTπ'PLAY "MB X" + VARPTR$(MBuff$)πRETURNπ28πSCREEN 13πEND SUBπAkarsha Vasant Kumar           MINESWEEPER FOR DOS            [e-mail]   08-30-96 (10:20)       QB, PDS                1102 26691    MINESWEE.BAS'###########################################################################π'########################### MINESWEEPER FOR DOS ###########################π'###########################################################################π'π'                           --- AKARSHA V. KUMARπ'                                Bombay , INDIA.ππ'Viola ! Now here's a real beaut . Took a lot of my time, but it works realπ'well ! There might be a few bugs ( tho me not find one ) and I would reallyπ'appreciate it if you point 'em out me so that I could fix 'em .π'I had to steal a few subroutines from previous ABCs and being the Mr.Niceπ'that I undoubtably am, I think I'll give these chaps some credit .π'Many thanx to :---π'1) Chris Wagner ( mouse subroutine ; the best I could find )π'2) Erik Olson   ( Edit Box subroutine ; real neat function )π'Keep up the good work guys and I'll always come up with an application !π'I was going to include a custom setup utility . I had already started makingπ'a subroutine . That I didn't find it challenging enough to get my grey cellsπ'ticking is a different story altogether ! . So u programming tyros out thereπ'vying to get ur names on the ABC, go ahead n' complete it if you want .π'And u programming gurus out there, tell me if you make any changes and doπ'ask me before ripping it apart .πππ'Coming Attraction :π'Watch out for WARSHIP I : A superb(?) space game with real neatπ'                          grafix n' sound ( varooom! varooom!! )ππ' Minesweeper 4 Dos : Source CodeππREM $INCLUDE: 'QBX.BI'ππDECLARE SUB FANCYPRINT (MSG$, X!, Y!)πDECLARE SUB VLINE (Y1!, Y2!, X!)πDECLARE SUB HLINE (X1!, X2!, Y!)πDECLARE SUB DELAY (D!)πDECLARE SUB DBLBOX (X1!, Y1!, X2!, Y2!, COLOR1, COLOR2)πDECLARE SUB BOX (X1!, Y1!, X2!, Y2!, COLOR1, COLOR2)πDECLARE SUB MOUSEON ()πDECLARE SUB MOUSEOFF ()πDECLARE SUB MouseSetHor (Min%, Max%)πDECLARE SUB MouseSetVert (Min%, Max%)πDECLARE SUB MouseLocate (Xpos%, Ypos%)πDECLARE SUB MouseStatus (VERT%, HOR%, MBUTTONS$)πDECLARE FUNCTION MouseInstalled% ()πDECLARE SUB AROUNDBOXCLEAR (I, J)πDECLARE SUB CLEARAROUNDZERO (I, J)πDECLARE SUB SHOWMINES ()πDECLARE SUB MENU ()πDECLARE SUB LEVELS ()πDECLARE SUB HELP ()πDECLARE SUB START ()πDECLARE SUB ABOUT ()πDECLARE SUB HISCORE ()πDECLARE SUB SHOWHISCORE ()πDECLARE SUB RESETSCORES ()πDECLARE SUB CHECKTIME ()πDECLARE FUNCTION EDITBOX$ (DEFAULT$, X, Y)πDECLARE SUB CUSTOMBOX ()ππTYPE INFOπ    FNAME AS STRING * 12π    time AS STRING * 10π    DATE AS STRING * 10πEND TYPEπDIM SHARED PLAYER AS INFOπDIM SHARED NUMOFBLOCKS AS INTEGERπDIM SHARED NEWGAMECANCELLEDπDIM SHARED NEWGAMEπDIM SHARED RegX AS RegTypeXπDIM SHARED WONπDIM SHARED LOSTπDIM SHARED TIMENOWππ    CALL MouseSetHor(1, 80)π    CALL MouseSetVert(1, 25)π    CALL MouseLocate(20, 70)π    CALL MOUSEONππSCREEN , , 1, 1πCLSπCALL STARTπCALL MENUπNEWGAME = 0: WON = 0: LOST = 0ππSTART:ππRANDOMIZE TIMER: TIMER ONπTYPE PROPERTIESπ    STARTX AS INTEGERπ    STARTY AS INTEGERπ    CONTENT AS STRING * 1π    CLEARED AS INTEGERπ    MARKED AS INTEGERπ    QMARKED AS INTEGERπ    ZEROCLEARED AS INTEGERπ    DRAWN AS INTEGERπEND TYPEππ'NUMOFBLOCKS = 25πNUMOFCOLS = 7πNUMOFMARKERS = NUMOFBLOCKSπNUMOFMINES = NUMOFBLOCKSππREDIM SHARED BLOCK(NUMOFBLOCKS, NUMOFCOLS) AS PROPERTIESπWON = 0: LOST = 0πNUMCLEARED = 0ππSCREEN , , 1, 1πCLSππLOCATE 25, 10: PRINT "Number of markers :"πLOCATE 25, 50: PRINT "Time :"πCOLOR 14, 12: LOCATE 25, 35: PRINT "  MENU  "ππFOR I = 1 TO NUMOFBLOCKSπFOR J = 1 TO NUMOFCOLSπBLOCK(I, J).CONTENT = ""πBLOCK(I, J).CLEARED = 0πBLOCK(I, J).MARKED = 0πBLOCK(I, J).QMARKED = 0πNEXT JπNEXT IππTEMP = 0π5 FOR MINE = 1 TO NUMOFBLOCKSπ10 I = INT(RND * NUMOFBLOCKS) + 1: J = INT(RND * 6) + 1πIF BLOCK(I, J).CONTENT = CHR$(21) THENπGOTO 10πELSE BLOCK(I, J).CONTENT = CHR$(21)πTEMP = TEMP + 1πEND IFπNEXT MINEπIF TEMP <> NUMOFBLOCKS THEN GOTO 5ππFOR X = 1 TO NUMOFBLOCKSπFOR Y = 1 TO NUMOFCOLSπTEMP = 0πIF BLOCK(X, Y).CONTENT <> CHR$(21) THENπIF X <> 1 AND Y <> 1 THENπIF BLOCK(X - 1, Y - 1).CONTENT = CHR$(21) THEN TEMP = TEMP + 1πEND IFπIF Y <> 1 THENπIF BLOCK(X, Y - 1).CONTENT = CHR$(21) THEN TEMP = TEMP + 1πEND IFπIF X <> NUMOFBLOCKS AND Y <> 1 THENπIF BLOCK(X + 1, Y - 1).CONTENT = CHR$(21) THEN TEMP = TEMP + 1πEND IFπIF X <> 1 THENπIF BLOCK(X - 1, Y).CONTENT = CHR$(21) THEN TEMP = TEMP + 1πEND IFπIF X <> NUMOFBLOCKS THENπIF BLOCK(X + 1, Y).CONTENT = CHR$(21) THEN TEMP = TEMP + 1πEND IFπIF X <> 1 AND Y <> NUMOFCOLS THENπIF BLOCK(X - 1, Y + 1).CONTENT = CHR$(21) THEN TEMP = TEMP + 1πEND IFπIF Y <> NUMOFCOLS THENπIF BLOCK(X, Y + 1).CONTENT = CHR$(21) THEN TEMP = TEMP + 1πEND IFπIF X <> NUMOFBLOCKS AND Y <> NUMOFCOLS THENπIF BLOCK(X + 1, Y + 1).CONTENT = CHR$(21) THEN TEMP = TEMP + 1πEND IFπBLOCK(X, Y).CONTENT = LTRIM$(STR$(TEMP))πEND IFπNEXT YπNEXT XππDRAWX = INT((80 - NUMOFBLOCKS * 3) / 2)πCALL DBLBOX(DRAWX - 1, 1, DRAWX + NUMOFBLOCKS * 3 + 2, 23, 11, 1)πFOR X = 1 TO NUMOFBLOCKSπFOR Y = 0 TO 6πCALL BOX(DRAWX - 2 + X * 3, Y * 3 + 2, DRAWX + X * 3, Y * 3 + 4, 1, 11)πBLOCK(X, Y + 1).STARTX = DRAWX - 2 + X * 3: BLOCK(X, Y + 1).STARTY = Y * 3 + 2π'LOCATE Y * 3 + 3, X * 3 + 1: PRINT BLOCK(X, Y + 1).CONTENTπNEXT YπNEXT XπCOLOR 10, 0ππLOCATE 4, 50π    πTIMEST = 0ππDOπ    CALL MouseStatus(VERT%, HOR%, MBUTTONS$)π    a$ = UCASE$(INKEY$)ππ    IF MBUTTONS$ = "L" THENπ    IF VERT% = 25 AND HOR% >= 35 AND HOR% <= 43 THENπ    CALL MENUπ    STARTIME = STARTIME + (TIMER - (STARTIME + TIMENOW))π    END IFπ    IF NEWGAME = 1 THEN NEWGAME = 0: GOTO STARTπ    FOR I = 1 TO NUMOFBLOCKSπ    FOR J = 1 TO NUMOFCOLSπ    IF HOR% >= BLOCK(I, J).STARTX AND HOR% <= BLOCK(I, J).STARTX + 2 THENπ        IF VERT% >= BLOCK(I, J).STARTY AND VERT% <= BLOCK(I, J).STARTY + 2 THENπ            IF TIMEST = 0 THENπ                STARTIME = TIMER: TIMEST = 1π            END IFπ            BLOCK(I, J).CLEARED = 1π            BLOCK(I, J).MARKED = 0: BLOCK(I, J).QMARKED = 0π            END IFππ    END IFπ    NEXT Jπ    NEXT Iπ    END IFππIF NEWGAME = 1 THEN NEWGAME = 0: GOTO STARTπ    IF MBUTTONS$ = "LR" THENππ    FOR I = 1 TO NUMOFBLOCKSπ    FOR J = 1 TO NUMOFCOLSπ    IF HOR% >= BLOCK(I, J).STARTX AND HOR% <= BLOCK(I, J).STARTX + 2 THENπ        IF VERT% >= BLOCK(I, J).STARTY AND VERT% <= BLOCK(I, J).STARTY + 2 THENπ            IF TIMEST = 0 THENπ                STARTIME = TIMER: TIMEST = 1π            END IFππ    IF BLOCK(I, J).CLEARED = 1 THENπ            CALL AROUNDBOXCLEAR(I, J)π    END IFπ        END IFπ    END IFπ    NEXT Jπ    NEXT Iππ    END IFππ    IF MBUTTONS$ = "R" THENπ    FOR I = 1 TO 5000: NEXT Iπ    FOR I = 1 TO NUMOFBLOCKSπ    FOR J = 1 TO NUMOFCOLSπ    IF HOR% >= BLOCK(I, J).STARTX AND HOR% <= BLOCK(I, J).STARTX + 2 THENπ        IF VERT% >= BLOCK(I, J).STARTY AND VERT% <= BLOCK(I, J).STARTY + 2 THENπ            IF TIMEST = 0 THENπ                STARTIME = TIMER: TIMEST = 1π            END IFπ        π        IF BLOCK(I, J).CLEARED = 0 THENππ        IF BLOCK(I, J).MARKED = 1 THENπ        BLOCK(I, J).MARKED = 0: BLOCK(I, J).QMARKED = 1: NUMOFMARKERS = NUMOFMARKERS + 1π        π            X = BLOCK(I, J).STARTX: Y = BLOCK(I, J).STARTYπ            CALL DBLBOX(X, Y, X + 2, Y + 2, 14, 5): COLOR 14, 5ππ        LOCATE BLOCK(I, J).STARTY + 1, BLOCK(I, J).STARTX + 1: PRINT "?"πππ        π        ELSEIF BLOCK(I, J).MARKED = 0 AND BLOCK(I, J).QMARKED = 0 THENπ        IF NUMOFMARKERS <> 0 THENπ        BLOCK(I, J).MARKED = 1: : NUMOFMARKERS = NUMOFMARKERS - 1π        π            X = BLOCK(I, J).STARTX: Y = BLOCK(I, J).STARTYπ            COLOR 1, 10: CALL DBLBOX(X, Y, X + 2, Y + 2, 14 + 16, 12): COLOR 14 + 16, 12ππ        LOCATE BLOCK(I, J).STARTY + 1, BLOCK(I, J).STARTX + 1: PRINT "M"π        END IFππ        ELSEIF BLOCK(I, J).QMARKED = 1 THENπ        BLOCK(I, J).QMARKED = 0: BLOCK(I, J).MARKED = 0π        π            X = BLOCK(I, J).STARTX: Y = BLOCK(I, J).STARTYπ            COLOR 2, 0: CALL BOX(X, Y, X + 2, Y + 2, 1, 11): COLOR 1, 11ππ        LOCATE BLOCK(I, J).STARTY + 1, BLOCK(I, J).STARTX + 1: PRINT ""ππ        END IFπ        END IFπ            π        END IFππ    END IFππ    NEXT Jπ    NEXT Iππ    END IFππCOLOR 15, 0πLOCATE 25, 30: PRINT LTRIM$(STR$(NUMOFMARKERS)) + " ";πIF TIMEST = 1 THENπTIMENOW = TIMER - STARTIMEπLOCATE 25, 57: PRINT USING "####.##"; TIMENOW;πEND IFπ    πIF a$ = "Q" THEN CALL MOUSEOFF: SYSTEMππFOR I = 1 TO NUMOFBLOCKSπFOR J = 1 TO NUMOFCOLSππIF BLOCK(I, J).CLEARED = 1 THENπNUMCLEARED = NUMCLEARED + 1ππIF BLOCK(I, J).MARKED = 0 AND BLOCK(I, J).DRAWN = 0 THENπX = BLOCK(I, J).STARTX: Y = BLOCK(I, J).STARTYπCALL BOX(X, Y, X + 2, Y + 2, 8, 0)πIF BLOCK(I, J).CONTENT <> "0" THEN LOCATE BLOCK(I, J).STARTY + 1, BLOCK(I, J).STARTX + 1: PRINT BLOCK(I, J).CONTENTπBLOCK(I, J).DRAWN = 1πEND IFππIF BLOCK(I, J).CONTENT = CHR$(21) AND BLOCK(I, J).MARKED = 0 THENπLOST = 1πCALL SHOWMINESπSLEEP (2)πCALL BOX(25, NUMOFCOLS, 55, 13, 13, 1)πCOLOR 2, 1πFOR X = 26 TO 54πFOR Y = 8 TO 12πLOCATE Y, X: PRINT CHR$(21)πNEXT YπNEXT XπCOLOR 13, 1πLOCATE 10, 31: PRINT " Block Has Mine !! "πSLEEP (2)πCALL MENUππEND IFππIF BLOCK(I, J).CONTENT = "0" AND BLOCK(I, J).ZEROCLEARED = 0 THENπCALL CLEARAROUNDZERO(I, J)πBLOCK(I, J).ZEROCLEARED = 1πEND IFππEND IFππNEXT JπNEXT IπIF NUMCLEARED = NUMOFBLOCKS * NUMOFCOLS - NUMOFMINES AND NEWGAMECANCELLED = 0 THENπWON = 1πCALL BOX(25, NUMOFCOLS, 55, 13, 14, 0)πCOLOR 2, 1πFOR X = 26 TO 54πFOR Y = 8 TO 12πLOCATE Y, X: PRINT CHR$(2)πNEXT YπNEXT XπCOLOR 12, 1πLOCATE 10, 34: PRINT " YOU WIN  !! "πSLEEP (2)πCALL CHECKTIMEπCALL MENUπELSE NUMCLEARED = 0πEND IFππ    LOOPππDATA "`MINESWEEPER' is a game involving skill and lotsa luck ."πDATA "All ya guys gotta do is to clear a minefield without "πDATA "blasting a mine . The number of markers at the start of "πDATA "game is = the number of mines in the grid . Click with "πDATA "the left mouse button to clear a block . The number that"πDATA "a cleared block shows is the number of blocks touching it"πDATA "which contain mines . If you are sure that a block has"πDATA "a mine then use the right mouse button to mark it . If "πDATA "you are doubtful about its contents , another click will"πDATA "question mark the block . A third click unmarks the block.πDATA "Clickin' both buttons together , clears all blocks around "πDATA "a block except those that have been marked previously."πDATA "For more help , go play the Windows version (He He He...)"ππSUB ABOUTπCALL MOUSEOFFπPCOPY 3, 4πCALL MOUSEONππCALL DBLBOX(15, 4, 64, 22, 12, 10)πCOLOR 8, 8:πFOR I = 16 TO 65πa = SCREEN(23, I)πLOCATE 23, I: PRINT CHR$(a)πNEXT IπFOR J = 5 TO 22πa = SCREEN(J, 65)πLOCATE J, 65: PRINT CHR$(a)πNEXT JππFOR I = 23 TO 53 STEP 3πCALL BOX(I, 5, I + 2, 7, 14, 12)πNEXT IπTITLE$ = "MINESWEEPER"πCOLOR 14, 12πFOR I = 1 TO 11πa$ = MID$(TITLE$, I, 1)πCALL FANCYPRINT(a$, 6, I * 3 + 21)πNEXT IπCALL BOX(36, 18, 46, 20, 1, 0)πCALL BOX(35, 17, 45, 19, 1, 15)πCOLOR 1, 15: LOCATE 18, 39: PRINT "OK"πCOLOR 10, 2πCALL FANCYPRINT("For DOS", 8, 35)πCALL FANCYPRINT("Version : 1.0 (1996)", 9, 29)πCALL FANCYPRINT("By : Akarsha V.Kumar , Bombay ,India .", 10, 21)πCALL FANCYPRINT("For comments and bugs e-mail me at :", 11, 21)πCALL FANCYPRINT("[e-mail]", 12, 24)πCALL FANCYPRINT("You are free to distribute this game .", 13, 21)πCALL FANCYPRINT("You may not expect future versions", 14, 22)πCALL FANCYPRINT("'cos this game ain't got no future .", 15, 21)ππDOπCALL MouseStatus(VERT%, HOR%, MBUTTONS$)πIF MBUTTONS$ = "L" THENπIF VERT% >= 17 AND VERT% <= 19 AND HOR% >= 35 AND HOR% <= 45 THENπEXIT DOπEND IFπEND IFπLOOPππPCOPY 4, 3πSCREEN , , 3, 3ππEND SUBππSUB AROUNDBOXCLEAR (I, J)ππIF I <> 1 AND J <> 1 THENπIF BLOCK(I - 1, J - 1).MARKED = 0 THEN BLOCK(I - 1, J - 1).CLEARED = 1πEND IFπIF J <> 1 THENπIF BLOCK(I, J - 1).MARKED = 0 THEN BLOCK(I, J - 1).CLEARED = 1πEND IFπIF I <> NUMOFBLOCKS AND J <> 1 THENπIF BLOCK(I + 1, J - 1).MARKED = 0 THEN BLOCK(I + 1, J - 1).CLEARED = 1πEND IFπIF I <> 1 THENπIF BLOCK(I - 1, J).MARKED = 0 THEN BLOCK(I - 1, J).CLEARED = 1πEND IFπIF I <> NUMOFBLOCKS THENπIF BLOCK(I + 1, J).MARKED = 0 THEN BLOCK(I + 1, J).CLEARED = 1πEND IFπIF I <> 1 AND J <> 7 THENπIF BLOCK(I - 1, J + 1).MARKED = 0 THEN BLOCK(I - 1, J + 1).CLEARED = 1πEND IFπIF J <> 7 THENπIF BLOCK(I, J + 1).MARKED = 0 THEN BLOCK(I, J + 1).CLEARED = 1πEND IFπIF I <> NUMOFBLOCKS AND J <> 7 THENπIF BLOCK(I + 1, J + 1).MARKED = 0 THEN BLOCK(I + 1, J + 1).CLEARED = 1πEND IFππEND SUBππSUB BOX (X1, Y1, X2, Y2, COLOR1, COLOR2)ππ'DRAW HORIZONTAL LINESππCOLOR COLOR1, COLOR2πIF X1 > X2 THEN ' DETERMINE GREATER CO-ORDINATEπGREATERX = X1: LESSERX = X2πELSEπGREATERX = X2: LESSERX = X1πEND IFππFOR I = (LESSERX + 1) TO (GREATERX - 1)πLOCATE Y1, I: PRINT CHR$(196);πLOCATE Y2, I: PRINT CHR$(196);πNEXT Iππ'DRAW VERTICAL LINESππIF Y1 > Y2 THEN ' DETERMINE GREATER CO-ORDINATEπGREATERY = Y1: LESSERY = Y2πELSEπGREATERY = Y2: LESSERY = Y1πEND IFππFOR I = LESSERY + 1 TO GREATERY - 1πLOCATE I, X1: PRINT CHR$(179);πLOCATE I, X2: PRINT CHR$(179);πNEXT Iππ'DRAW CORNERSπLOCATE LESSERY, LESSERX: PRINT CHR$(218);πLOCATE GREATERY, GREATERX: PRINT CHR$(217);πLOCATE LESSERY, GREATERX: PRINT CHR$(191);πLOCATE GREATERY, LESSERX: PRINT CHR$(192);ππFOR I = LESSERX + 1 TO GREATERX - 1πFOR J = LESSERY + 1 TO GREATERY - 1πLOCATE J, I: PRINT " ";πNEXT JπNEXT IππCOLOR 7, 0πEND SUBππSUB CHECKTIMEπOPEN "HISCORE.DAT" FOR RANDOM AS #1ππFOR I = 1 TO 4πIF NUMOFBLOCKS = I * 5 + 5 THENπGET #1, I, PLAYERπIF TIMENOW < VAL(PLAYER.time) THENπCALL BOX(20, 6, 60, 14, 0, 15)πCOLOR 2, 1πFOR X = 21 TO 59πFOR Y = 7 TO 13πLOCATE Y, X: PRINT CHR$(2)πNEXT YπNEXT XπCOLOR 0, 15πLOCATE 6, 25: PRINT " HI SCORE :"πCOLOR 15, 1πLOCATE 8, 25: PRINT " You have made a new record. "πLOCATE 9, 25: PRINT " Please enter your name :- "πPLAYER.FNAME = EDITBOX$("            ", 34, 11)πPLAYER.time = STR$(TIMENOW)πPLAYER.DATE = DATE$πPUT #1, I, PLAYERπCLOSE #1πCALL SHOWHISCOREπEXIT FORπEND IFπEND IFπNEXT IπCLOSE #1πEND SUBππSUB CLEARAROUNDZERO (I, J)ππIF I <> 1 AND J <> 1 THENπIF BLOCK(I - 1, J - 1).MARKED = 0 AND BLOCK(I - 1, J - 1).CONTENT <> "M" THEN BLOCK(I - 1, J - 1).CLEARED = 1πEND IFπIF J <> 1 THENπIF BLOCK(I, J - 1).MARKED = 0 AND BLOCK(I, J - 1).CONTENT <> "M" THEN BLOCK(I, J - 1).CLEARED = 1πEND IFπIF I <> NUMOFBLOCKS AND J <> 1 THENπIF BLOCK(I + 1, J - 1).MARKED = 0 AND BLOCK(I + 1, J - 1).CONTENT <> "M" THEN BLOCK(I + 1, J - 1).CLEARED = 1πEND IFπIF I <> 1 THENπIF BLOCK(I - 1, J).MARKED = 0 AND BLOCK(I - 1, J).CONTENT <> "M" THEN BLOCK(I - 1, J).CLEARED = 1πEND IFπIF I <> NUMOFBLOCKS THENπIF BLOCK(I + 1, J).MARKED = 0 AND BLOCK(I + 1, J).CONTENT <> "M" THEN BLOCK(I + 1, J).CLEARED = 1πEND IFπIF I <> 1 AND J <> 7 THENπIF BLOCK(I - 1, J + 1).MARKED = 0 AND BLOCK(I - 1, J + 1).CONTENT <> "M" THEN BLOCK(I - 1, J + 1).CLEARED = 1πEND IFπIF J <> 7 THENπIF BLOCK(I, J + 1).MARKED = 0 AND BLOCK(I, J + 1).CONTENT <> "M" THEN BLOCK(I, J + 1).CLEARED = 1πEND IFπIF I <> NUMOFBLOCKS AND J <> 7 THENπIF BLOCK(I + 1, J + 1).MARKED = 0 AND BLOCK(I + 1, J + 1).CONTENT <> "M" THEN BLOCK(I + 1, J + 1).CLEARED = 1πEND IFππEND SUBππSUB CUSTOMBOXπCALL MOUSEOFFπPCOPY 5, 6πCALL MOUSEONπCUSTOMROW = 28ππCALL DBLBOX(20, 3, 60, 20, 1, 2)πCOLOR 10, 0πLOCATE 6, 27: PRINT CHR$(17)πLOCATE 6, 54: PRINT CHR$(16)πCOLOR 10, 2πFOR I = 28 TO 53πLOCATE 6, I: PRINT CHR$(176)πNEXT IπLOCATE 6, CUSTOMROW: PRINT CHR$(219)πCALL BOX(36, 16, 46, 18, 1, 0)πCALL BOX(35, 15, 45, 17, 1, 15)πDOπCALL MouseStatus(VERT%, HOR%, MBUTTONS$)πIF MBUTTONS$ = "L" THENπIF VERT% = 6 THENπIF HOR% = 27 THENπDELAY (2000)πIF CUSTOMROW > 28 THEN CUSTOMROW = CUSTOMROW - 1πEND IFπIF HOR% = 54 THENπDELAY (2000)πIF CUSTOMROW < 53 THEN CUSTOMROW = CUSTOMROW + 1πEND IFπEND IFπIF VERT% >= 15 AND VERT% <= 17 AND HOR% >= 35 AND HOR% <= 45 THENπEXIT DOπEND IFπCOLOR 10, 0πLOCATE 6, 27: PRINT CHR$(17)πLOCATE 6, 54: PRINT CHR$(16)πCOLOR 10, 2πFOR I = 28 TO 53πLOCATE 6, I: PRINT CHR$(176)πNEXT IπLOCATE 6, CUSTOMROW: PRINT CHR$(219)πEND IFπLOOPπDELAY (5000)πPCOPY 6, 5πSCREEN , , 5, 5πEND SUBππSUB DBLBOX (X1, Y1, X2, Y2, COLOR1, COLOR2)ππ'CHECK FOR VALID CO-ORDINATESπIF X1 > 80 OR X1 < 1 OR X2 > 80 OR X2 < 1 OR Y1 > 24 OR Y1 < 1 OR Y2 > 24 OR Y2 < 1 THEN GOTO 100ππCOLOR COLOR1, COLOR2ππIF X1 > X2 THEN ' DETERMINE GREATER CO-ORDINATEπGREATERX = X1: LESSERX = X2πELSEπGREATERX = X2: LESSERX = X1πEND IFππ'DRAW HORIZONTAL LINESπFOR I = (LESSERX + 1) TO (GREATERX - 1)πLOCATE Y1, I: PRINT CHR$(205);πLOCATE Y2, I: PRINT CHR$(205);πNEXT Iππ'DRAW VERTICAL LINESππIF Y1 > Y2 THEN ' DETERMINE GREATER CO-ORDINATEπGREATERY = Y1: LESSERY = Y2πELSEπGREATERY = Y2: LESSERY = Y1πEND IFππFOR I = LESSERY + 1 TO GREATERY - 1πLOCATE I, X1: PRINT CHR$(186);πLOCATE I, X2: PRINT CHR$(186);πNEXT Iππ'DRAW CORNERSπLOCATE LESSERY, LESSERX: PRINT CHR$(201);πLOCATE GREATERY, GREATERX: PRINT CHR$(188);πLOCATE LESSERY, GREATERX: PRINT CHR$(187);πLOCATE GREATERY, LESSERX: PRINT CHR$(200);ππFOR I = LESSERX + 1 TO GREATERX - 1πFOR J = LESSERY + 1 TO GREATERY - 1πLOCATE J, I: PRINT " ";πNEXT JπNEXT IππCOLOR 7, 0ππ100 END SUBππSUB DELAY (D)πFOR I = 1 TO DπNEXT IπEND SUBππFUNCTION EDITBOX$ (DEFAULT$, X, Y)πDOππ   LOCATE Y, X: PRINT DEFAULT$' if you want to put the box somewhereπ   LOCATE Y, X + YY: PRINT CHR$(2)      ' else, change these locate statementsπππ   DO: a$ = INKEY$: LOOP WHILE LEN(a$) = 0π   IF LEN(a$) THENπ     SELECT CASE (a$)π     CASE CHR$(27), CHR$(13)π     'END SELECTπ     CASE CHR$(8)π     IF YY THENπ        YY = YY - 1π        IF YY THENπ          DEFAULT$ = LEFT$(DEFAULT$, YY) + MID$(DEFAULT$, YY + 2) + " "π        ELSEπ          DEFAULT$ = MID$(DEFAULT$, YY + 2) + " "π        END IFπ     END IFπ     CASE CHR$(0) + CHR$(83)π     IF YY THENπ        DEFAULT$ = LEFT$(DEFAULT$, YY) + MID$(DEFAULT$, YY + 2) + " "π     ELSEπ        DEFAULT$ = MID$(DEFAULT$, YY + 2) + " "π     END IFπ     CASE CHR$(0) + CHR$(&H4D)π     IF YY < LEN(DEFAULT$) THEN YY = YY + 1π     CASE CHR$(0) + CHR$(&H4B)π     IF YY THEN YY = YY - 1π     CASE CHR$(0) + CHR$(79)'endπ     YY = LEN(RTRIM$(DEFAULT$))π     CASE CHR$(0) + CHR$(71)π     YY = 0ππ     CASE ELSEπ     IF LEN(a$) = 1 AND YY = 0 THEN DEFAULT$ = SPACE$(LEN(DEFAULT$))π     IF LEN(a$) = 1 AND YY < LEN(DEFAULT$) THEN MID$(DEFAULT$, YY + 1, 1) = a$: YY = YY + 1ππ     END SELECTπ     IF a$ = CHR$(27) THEN EDITBOX$ = "": EXIT DOπ     IF a$ = CHR$(13) THEN EDITBOX$ = RTRIM$(DEFAULT$): EXIT DOππ   END IFπLOOPπEND FUNCTIONππSUB FANCYPRINT (MSG$, X, Y)πLOCATE X, YπFOR I = 1 TO LEN(MSG$)πM$ = MID$(MSG$, I, 1)πPRINT M$; : IF M$ = " " THEN SOUND 500, 1πDELAY (750)πNEXT IπEND SUBππSUB HELPππCALL MOUSEOFFπPCOPY 3, 4πCALL MOUSEONπCALL DBLBOX(5, 2, 75, 23, 0, 13)πCOLOR 14, 13πLOCATE 3, 29: PRINT " MINESWEEPER HELP "ππCOLOR 0, 13πFOR Y = 5 TO 17πREAD HLP$πLOCATE Y, 10: PRINT HLP$πNEXT YπCALL BOX(35, 20, 45, 22, 1, 1)πCALL BOX(34, 19, 44, 21, 1, 15)πCOLOR 1, 15πLOCATE 20, 38: PRINT "OK"πDOπCALL MouseStatus(VERT%, HOR%, MBUTTONS$)πIF MBUTTONS$ = "L" THENπIF VERT% >= 19 AND VERT% <= 21 AND HOR% >= 34 AND HOR% <= 44 THENπEXIT DOπEND IFπEND IFπLOOPππRESTOREπPCOPY 4, 3πSCREEN , , 3, 3ππEND SUBππSUB HISCOREππEND SUBππSUB HLINE (X1, X2, Y)ππ'DETERMINE GREATER X CO-ORDINATEπIF X1 > X2 THENπGREATER = X1: LESSER = X2πELSEπGREATER = X2: LESSER = X1πEND IFπFOR I = LESSER TO GREATERπLOCATE Y, I: PRINT CHR$(196)πNEXT IππEND SUBππSUB LEVELSπCALL MOUSEOFFπPCOPY 3, 4: PCOPY 4, 5πCALL MOUSEONπSCREEN , , 5, 5πCALL DBLBOX(10, 5, 70, 20, 0, 12)ππFOR X = 15 TO 35 STEP 19πFOR Y = 7 TO 14 STEP 7πCALL BOX(X + 1, Y + 1, X + 14, Y + 3, 8, 8)πCALL BOX(X, Y, X + 13, Y + 2, 1, 15)πNEXT YπNEXT XπCALL BOX(53, 12, 67, 14, 8, 8)πCALL BOX(52, 11, 66, 13, 1, 15)ππCOLOR 1, 15πLOCATE 8, 18: PRINT "LEVEL 1"πLOCATE 8, 37: PRINT "LEVEL 3"π'LOCATE 8, 57: PRINT "CUSTOM"πLOCATE 15, 18: PRINT "LEVEL 2"πLOCATE 15, 37: PRINT "LEVEL 4"πLOCATE 12, 56: PRINT "CANCEL"ππDOπCALL MouseStatus(VERT%, HOR%, MBUTTONS$)πIF MBUTTONS$ = "L" THENπIF VERT% >= 7 AND VERT% <= 9 AND HOR% >= 15 AND HOR% <= 29 THENπNUMOFBLOCKS = 10: NEWGAMECANCELLED = 0: EXIT DOπEXIT DOπEND IFπIF VERT% >= 7 AND VERT% <= 9 AND HOR% >= 34 AND HOR% <= 47 THENπNUMOFBLOCKS = 20: NEWGAMECANCELLED = 0: EXIT DOπEND IFπ'IF VERT% >= 7 AND VERT% <= 9 AND HOR% >= 53 AND HOR% <= 66 THENπ'CALL CUSTOMBOXπ'END IFπIF VERT% >= 14 AND VERT% <= 16 AND HOR% >= 15 AND HOR% <= 29 THENπNUMOFBLOCKS = 15: NEWGAMECANCELLED = 0: EXIT DOπEND IFπIF VERT% >= 14 AND VERT% <= 16 AND HOR% >= 34 AND HOR% <= 47 THENπNUMOFBLOCKS = 25: NEWGAMECANCELLED = 0: EXIT DOπEND IFπIF VERT% >= 11 AND VERT% <= 13 AND HOR% >= 52 AND HOR% <= 66 THENπNEWGAMECANCELLED = 1πEXIT DOπEND IFπEND IFπLOOPπPCOPY 4, 3πSCREEN , , 3, 3πDELAY (10000)πEND SUBππSUB MENUπCALL MOUSEOFFπPCOPY 1, 2: PCOPY 2, 3πSCREEN , , 3, 2πCALL DBLBOX(10, 5, 70, 20, 2, 15)πCOLOR 8, 8:πFOR I = 11 TO 71πa = SCREEN(21, I)πLOCATE 21, I: PRINT CHR$(a)πNEXT IπFOR J = 6 TO 20πa = SCREEN(J, 71)πLOCATE J, 71: PRINT CHR$(a)πNEXT JππFOR X = 15 TO 58 STEP 19πFOR Y = 7 TO 14 STEP 7πCALL BOX(X + 1, Y + 1, X + 14, Y + 3, 8, 8)πCALL BOX(X, Y, X + 13, Y + 2, 1, 14)πNEXT YπNEXT XπSCREEN , , 3, 3ππCOLOR 15, 14πLOCATE 8, 18: PRINT "NEW GAME"πLOCATE 8, 37: PRINT "CONTINUE"πLOCATE 8, 58: PRINT "HELP"πLOCATE 15, 19: PRINT "ABOUT"πLOCATE 15, 36: PRINT "BEST TIMES"πLOCATE 15, 58: PRINT "EXIT"ππCALL MOUSEONππDOπCALL MouseStatus(VERT%, HOR%, MBUTTONS$)πIF MBUTTONS$ = "L" THENπIF VERT% >= 7 AND VERT% <= 9 AND HOR% >= 15 AND HOR% <= 29 THENπCALL LEVELSπIF NEWGAMECANCELLED = 0 THENπNEWGAME = 1πEXIT DOπEND IFπEND IFππIF VERT% >= 7 AND VERT% <= 9 AND HOR% >= 34 AND HOR% <= 47 THENπIF WON = 1 OR LOST = 1 OR NUMOFBLOCKS = 0 THENπBEEPπELSE EXIT DOπEND IFππEND IFπIF VERT% >= 7 AND VERT% <= 9 AND HOR% >= 53 AND HOR% <= 66 THENπCALL HELPπEND IFπIF VERT% >= 14 AND VERT% <= 16 AND HOR% >= 15 AND HOR% <= 29 THENπCALL ABOUTπEND IFπIF VERT% >= 14 AND VERT% <= 16 AND HOR% >= 34 AND HOR% <= 47 THENπCALL SHOWHISCOREπEND IFπIF VERT% >= 14 AND VERT% <= 16 AND HOR% >= 53 AND HOR% <= 66 THENπCOLOR 10, 0πCALL MOUSEOFF: CLS : SYSTEMπEND IFπEND IFπLOOPππDELAY (10000)πPCOPY 2, 1πSCREEN , , 1, 1ππEND SUBππFUNCTION MouseInstalled%π    DEF SEG = 0π    MouseSeg& = 256& * PEEK(207) + PEEK(206)π    MouseOfs& = 256& * PEEK(205) + PEEK(204) + 2π    DEF SEG = MouseSeg&π    IF (MouseSeg& = 0 AND MouseOfs& = 0) OR PEEK(MouseOfs&) = 207 THENπ    MouseInstalled% = 0π    EXIT FUNCTIONπ    ELSEπ    MouseInstalled% = -1π    END IFπ    DEF SEGπ    RegX.ax = 0π    CALL INTERRUPTX(&H33, RegX, RegX)π    IF RegX.ax = -1 THENπ    MouseInstalled% = -1π    ELSEπ    MouseInstalled% = 0π    END IFπEND FUNCTIONππSUB MouseLocate (Xpos%, Ypos%)π    RegX.dx = (Xpos% * 8) - 1π    RegX.cx = (Ypos% * 8) - 1π    RegX.ax = 4π    CALL INTERRUPTX(&H33, RegX, RegX)πEND SUBππSUB MOUSEOFFπ    RegX.ax = 2π    CALL INTERRUPTX(&H33, RegX, RegX)πEND SUBππSUB MOUSEONπ    RegX.ax = 1π    CALL INTERRUPTX(&H33, RegX, RegX)πEND SUBππSUB MouseSetHor (Min%, Max%)π    RegX.cx = (Min% * 8) - 1π    RegX.dx = (Max% * 8) - 1π    RegX.ax = 7π    CALL INTERRUPTX(&H33, RegX, RegX)πEND SUBππSUB MouseSetVert (Min%, Max%)π    RegX.cx = (Min% * 8) - 1π    RegX.dx = (Max% * 8) - 1π    RegX.ax = 8π    CALL INTERRUPTX(&H33, RegX, RegX)πEND SUBππSUB MouseStatus (VERT%, HOR%, MBUTTONS$)π    RegX.ax = 3π    CALL INTERRUPTX(&H33, RegX, RegX)π    VERT% = (RegX.dx / 8) + 1π    HOR% = (RegX.cx / 8) + 1π    SELECT CASE RegX.bxπ    CASE 0π        MBUTTONS$ = " "π    CASE 1π        MBUTTONS$ = "L"π    CASE 2π        MBUTTONS$ = "R"π    CASE 3π        MBUTTONS$ = "LR"π    CASE 4π        MBUTTONS$ = "C"π    END SELECTπEND SUBππSUB RESETSCORESπOPEN "HISCORE.DAT" FOR RANDOM AS #1πPLAYER.FNAME = "Anonymous"πPLAYER.time = "9999999999"πPLAYER.DATE = "-"ππFOR I = 1 TO 4πPUT #1, I, PLAYERπNEXT IπCLOSE #1ππEND SUBππSUB SHOWHISCOREπCALL MOUSEOFFπPCOPY 3, 4πCALL MOUSEONπCALL DBLBOX(1, 1, 80, 24, 8, 15)πFOR X = 3 TO 63 STEP 19πFOR Y = 4 TO 17 STEP 4πCALL BOX(X + 1, Y + 1, X + 17, Y + 3, 2, 1)πCALL BOX(X, Y, X + 16, Y + 2, 1, 15)πNEXT YπNEXT XπCALL BOX(21, 21, 31, 23, 2, 1)πCALL BOX(20, 20, 30, 22, 1, 15)πCALL BOX(36, 21, 56, 23, 2, 1)πCALL BOX(35, 20, 55, 22, 1, 15)ππOPEN "HISCORE.DAT" FOR RANDOM AS #1πIF LOF(1) = 0 THENπCLOSE #1: CALL RESETSCORESπOPEN "HISCORE.DAT" FOR RANDOM AS #1πEND IFππCOLOR 0, 15πFOR I = 1 TO 4πGET #1, I, PLAYERπLOCATE I * 4 + 1, 8: PRINT "LEVEL :"; IπLOCATE I * 4 + 1, INT(31 - .5 * (LEN(RTRIM$(PLAYER.FNAME)))): PRINT RTRIM$(PLAYER.FNAME)πLOCATE I * 4 + 1, INT(50 - .5 * (LEN(RTRIM$((PLAYER.time))))): PRINT RTRIM$(PLAYER.time)πLOCATE I * 4 + 1, INT(69 - .5 * (LEN(RTRIM$((PLAYER.DATE))))): PRINT RTRIM$(PLAYER.DATE)πNEXT IπCLOSE #1ππLOCATE 21, 24: PRINT "OK"πLOCATE 21, 39: PRINT "RESET SCORES"ππCOLOR 8, 15πLOCATE 2, 35: PRINT "BEST TIMES"ππLOCATE 3, 8: PRINT "LEVEL"πLOCATE 3, 29: PRINT "NAME"πLOCATE 3, 45: PRINT "TIME (sec)"πLOCATE 3, 67: PRINT "DATE"ππDOπCALL MouseStatus(VERT%, HOR%, MBUTTONS$)πIF MBUTTONS$ = "L" THENπIF VERT% >= 20 AND VERT% <= 22 THENπIF HOR% >= 20 AND HOR% <= 30 THENπEXIT DOπEND IFπIF HOR% >= 35 AND HOR% <= 55 THENπCALL RESETSCORESπEXIT DOπEND IFπEND IFπEND IFπLOOPππPCOPY 4, 3πSCREEN , , 3, 3π'DELAY (10000)ππEND SUBππSUB SHOWMINESπBEEPπFOR I = 1 TO NUMOFBLOCKSπFOR J = 1 TO 7πIF BLOCK(I, J).CONTENT = CHR$(21) THENπCOLOR 10, 2πX = BLOCK(I, J).STARTX: Y = BLOCK(I, J).STARTYπCALL DBLBOX(X, Y, X + 2, Y + 2, 12, 1)πLOCATE Y + 1, X + 1: PRINT BLOCK(I, J).CONTENTπEND IFπNEXT JπNEXT IπCOLOR 10, 0πEND SUBππSUB STARTπCLSπFOR I = 1 TO 80: FOR J = 1 TO 6: PRINT CHR$(219); : NEXT J: NEXT IπFOR I = 1 TO 80: FOR J = 1 TO 6: PRINT CHR$(178); : NEXT J: NEXT IπFOR I = 1 TO 80: FOR J = 1 TO 6: PRINT CHR$(177); : NEXT J: NEXT IπFOR I = 1 TO 80: FOR J = 1 TO 6: PRINT CHR$(176); : NEXT J: NEXT IππCALL DBLBOX(20, 8, 58, 17, 1, 11)πCOLOR 8, 0:πFOR I = 21 TO 59πa = SCREEN(18, I)πLOCATE 18, I: PRINT CHR$(a)πNEXT IπFOR J = 9 TO 17πa = SCREEN(J, 59)πLOCATE J, 59: PRINT CHR$(a)πNEXT JππFOR I = 23 TO 53 STEP 3πCALL BOX(I, 10, I + 2, 12, 11, 1)πNEXT IπTITLE$ = "MINESWEEPER"πCOLOR 9, 1πFOR I = 1 TO 11πa$ = MID$(TITLE$, I, 1)πLOCATE 11, I * 3 + 21: PRINT a$πNEXT IπCOLOR 1, 11πLOCATE 13, 35: PRINT "For DOS"πIF NOT MouseInstalled% THENπLOCATE 15, 22: PRINT " Sorry , system must have a mouse !"πSLEEP (2)πCOLOR 1, 0: CLS : SYSTEMπELSEπLOCATE 15, 29: PRINT "Mouse found and reset ."πCALL MOUSEONπEND IFππEND SUBππSUB VLINE (Y1, Y2, X)ππ'DETERMINE GREATER Y CO-ORDINATEπIF Y1 > Y2 THENπGREATER = Y1: LESSER = Y2πELSEπGREATER = Y2: LESSER = Y1πEND IFπFOR I = LESSER TO GREATERπLOCATE I, X: PRINT CHR$(179)πNEXT IππEND SUBπAndy J. Golden                 STAR TREK COMMUNICATOR PIN     [e-mail]             06-14-96 (00:00)       QB, QBasic, PDS        55   1847     STPIN.BAS   ' Star Trek: The Next Generation - Communicator Pin.π' BASIC graphics program by Andy Golden - June 14, 1996.π'    This program was not created, approved, licensed,π'    or endorsed by any entity involved in creating orπ'    producing the Star Trek(R) television series orπ'    films.ππdim y(5)πscreen 1πwindow (-10,-10)-(10,10)πfor z=1 to 5π  for x=-10 to 10 step .1π    y(1)=-x^2+8π    if x>=0 then    y(2)=-x^1.5-1         else    y(2)=11π    if x<=0 then    y(3)=-abs(x)^1.5-1    else    y(3)=11π    y(4)=sqr(49-49*(x^2)/100)-1π    y(5)=-y(4)-2π    pset(x,y(z))π  nextπnextππ' I originally wrote this program on my TI-85 graphingπ' calculator in Algebra II class back some time aroundπ' February 1996.  Then on June 14, 1996, I decided toπ' translate it to work with PowerBASIC and QBASIC andπ' other BASICs for an IBM compatible PC.  The resultπ' is the program above.  The equations y(2) and y(3)π' had to be modified because BASIC just can't handleπ' imaginary numbers; so I used a cheesy IF/THEN/ELSEπ' statement to eliminate them because I just don't feelπ' like setting here for a few weeks writing all my ownπ' mathematical subroutines and functions to handleπ' imaginary numbers.  Maybe some other time.  :-)π'π' Here is what all the equations do:π'   y(1)   Draws an archπ'   y(2)   Draws right leg of communicator pinπ'   y(3)   Draws left leg of pinπ'   y(4)   Draws top half of ellipseπ'   y(5)   Draws bottom half of ellipseπ'π' Here is the original program for the TI-85:π'π'   FnOff                    Replace the word Square Rootπ'   Func                     in equation  y4  with theπ'   AxesOff                  square root symbol.π'   ClLCDπ'   ClDrwπ'   Zstdπ'   y1=-x^2+8π'   y2=-x^1.5-1π'   y3=-((-x)^1.5)-1π'   y4=Square Root (49-49x^2/100)-1π'   y5=-y4-2π'   FnOnπSteven Sensarn                 SCROLLING CELL MAP             [e-mail]          07-08-96 (00:00)       QB, QBasic, PDS        50  3227     CELLS.BAS   DEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"CELLS.ZIP",4^6:Z&=2141:?STRING$(50,177);πU"%up()%9%%%I-%aaf_EBa&yjm%%%%%(%%%.%%%%hj%qqxS[ufqf,a*2%%V-(b8ilπU"lM.91aWahu5m+NuaxMK$b_%4._(*I[KYi/i6^0'_uInRif-/_61DT.7uM^Sfd\%πU"x6^Rfg*mi,'l'u%p()9%%%%-g%da_jEE1W'QJ'%(%K7%%%.%%%%hjq%qxSiRfyfπU"%2,FREj1&Yqu7Xx+DN(JG'G7E=UE%4M0%4rL)E+TFf2ICX5f(Z(B$/0.1J_0.AOπU"'U'_ISx9FBYN%*YLsC?HK34n2(<M#?&KYI%Bg-tQJ,V1eS+.l[pu.FZm>U4W60EπU"I#e9\,B-W4ei8&_b$)gdb09Ri\01T$d^fHXgYNVO>^M<i&r%(W,,('1KlUuX'd_πU"hYL7D5;E?01S&tXhn[5lP$I^wWSLQRbzjV%(EVr%i5RC4NDiW5R6=\W\Dt,P*%[πU"-51DBKRp].6%[fkOYCkk$PDq_Y%,M*t#AFTj]?DaBPzq*<mE%q0+Q^63?T%c\a%πU"D'8tp8[TYf'udaH^<O#-)0p2mjcFm]D06)q#e::JB<stO[q^+POnI?mERQ+IgndπU"&-1,fV%Y&f;oUo4<O+rI.<ki/4pN(eOOE0SVOKXwXV1R4Qp\Ck)pT]r1i-11PWMπU"mX0x[FQ/]kZm#E?U?D=P,&#A4$+0OR0:28/I.zxdpHxpV_b)z8k4Ro.6o[[l?WvπU">.n9Z%NH3S89Hhab%4XNmz;J*2(kc4Q-<OsWv0n5KtZTS+FQ1Odm^uJlb$*izp=πU"=p%-kJd<XTW&S,FvWF11MQlwY_:o+_]P$9Ox%lR$xzaMQ3oIN3x:LcO4&K2\,\VπU"c>FbB=>nvtR?/r=0?f'xh1?'^v:0)tBT-rIX0ko(zeNDe#oxBk7(aM%u%p()9%%πU"%%-j%6a_OETZc+19)%+%n9%%%.%%%%hjq%qxSgRfxV';<>\[+1wCEWxPAYrN=+-πU"OsP:=f1CoQIoHk2j#/A*BpRn>ZhtvnIloM$[A$n4#$1=JRT[BVAsmoqC#?d3gNVπU";,AOR8A2iAhW;nR\3(,uui4MEZHqM_+fQM$0g&DhmY*FaymiWr$)n_pR\P#FaM$πU"4L+\n;??j2v\U3C,MA4#7yIM:A=Ov#+tUj6<.[J(0d%ohPtk?]T3r[2)9*6oA:bπU"Vu:.KI9D*F<[6IG$Mp\(#6j5a-Hk_[wL9Cre1N*B/lB4Vdk7,-i49[4.9&z0Gs/πU"[&*syh:M]wQW*U-H.12?YG(UcZ9.Q*ahRV+XE<]ROXZMH,Uc$is:=ec*J+3D?2IπU"Q3E#2J.FwM_P'h/B;?,iE$GE2-DI)?I;>BP_4ghBMnHIS?(SJVMyF2d0^;5U2UhπU"8z>v7PS0nNYW;hYa>c&NP/$-wXl'+\BXWw-4SmMQ=BN^XwXT;7]L,W;71L,hnA1πU"CPFt1TgvmK;M[(=eD;jpsvLJe?u<F#H21&%m6lETRG]UGA,L^:Uyt(LKhp-bu'pπU",CQ-pH5)hP7)b#N.bbX;i)hT#0n$<.W7KfPODCL1h^V:s&7oq:g'jXxpQm\DQm/πU"AN,b_l)56Z9&*E(^iK;]047UFvCK9q-wON6A5^*g?%m7>42T$:6>B(Z^mV5ccl0πU">2vm]2BN9YGW=7ZNp$)C\T*PY=.xwe^fgo__h=pE#Mt^mEXD]EI/9j6d(_EZPR*πU"j\5o?.dPw#V],okK#m^_G8#j[CzrShBA)j3y,Mjh^Y86ioTOw;ro8;AvSFG-Mq=πU"t51?+3;]sTMS/=G5&mjscp&fP-*Z2BoWsX3vs^eGrMrC;sa0zWcJM+jh+$Yh'V.πU"gT48t?CPK<(6OrK\jNHJmXWOnkduu2VNbsn38+[7G&mp1nFXMpPITO2jLjdf]:XπU"rChPH8Etp-&#fChcI#AQJBxCEv&bLHdbcS0KOs*tl,FYvsEi/s[F]V4\G(pXnSFπU"a8UNZc5NJH;+qF.6-ksetbK+J&nO(oD73i:_8UD?d>lZva^s/6Cxn.L2l2=7bJ6πU"znGxcSyl,EFOjG1AOLQhORacMc4?*pR=Mw0c3mqB\2XS76N*pecv;f+.yuBPBMuπU"3b.%T_d:75C=yDf#UIR6pxkk9g4vd)6_m$eq<svWZ?Q:FgG^nTtT8FoKTt,oAdxπU"gYs8w>rA.xa>sXGHDF4vEXT4<0PvdPN6o$$r^&:OdbIWL3DIbt9&m<'D\E?uLu0πU"lr>Ka\j-G.HpL&imoONJZQ-oU.86MElI:_1Mmr2oa[cZp4D_TCtrwQ3Ya7R4+fyπU"nV<s$=']'yP<J:KP99j$5DQfE]pl06a92$-M%I8UYIaKl]VfJKU+DX(rnFDbERTπU"IZpgAd4KN$m:WI+h+]\Z<7=Z2EC:CiT[TWmqMYDh8jrYND^**/cVev9JI/p-^6'πU"h.FB\i,m:qT*qJ:=Kw$;GJ]_Lb0h.$>>#,uGHXfo*#nduja?qC*e6NdZ>,ia2ICπU"Z3BI:QcL8x2k/Oq(SAwCjT?Om2Xptq2AX]yieOr/Wo:wUS'Cdup%&'9%%9%%%I-πU"%aaf_EBa&yjm%%%%%(%%%.%%%%%%%%%%%%E%%%%%%%%%hjqq%xSuf%qup&%'9%9πU"%%%%-g%da_jEE1W'QJ'%(%K7%%%.%%%%%%%%%%%E#%%%>%%%%h%jqqx%Sify%upπU"&'%9%9%%%%-%<6a_E3TZc1'9)%%'n9%%%.%%%%%%%%%&%E%7%%4'%%%hj%qqxS%πU"gfxu%p*+%%%%%(#%(%t#%%%q%,%%%%%πEND SUBπCLOSE:IF S=28AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπScott Tuttle                   SCREEN ART/SAVER               [e-mail]      07-08-96 (20:23)       QB, QBasic, PDS        198  6816     ARTS.BAS    'Screen Art/Saver inspired by John Wantlands Black Holeπ'but for faaster computers.ππRANDOMIZE TIMERπDEFINT A-ZππSCREEN 13                       'πmaxx = 320                      'screen dimensionsπmaxy = 199                      'can be set for different modesππFOR t = 1 TO 255                ' sets palette to shades of whiteπb = INT(63 / 255 * t)πOUT &H3C6, 255πOUT &H3C8, 256 - tπOUT &H3C9, bπOUT &H3C9, bπOUT &H3C9, bπNEXT tππ                                            'rem these out for QBASICπIF COMMAND$ <> "" THEN                      'check command lineπ        num = VAL(COMMAND$)                 'for number of pixelsπ        IF num < 10 THEN num = 10          π        END IFπIF COMMAND$ = "" THEN num = 100             'to hereππDIM x!(num), y!(num), dx!(num), dy!(num)πππcx = maxx \ 2                              'center coor for current screenπcy = maxy \ 2πrr = 10                                    'diameter of black holeπFOR t = 1 TO num                           'init coors and speedπx!(t) = RND * maxxπy!(t) = RND * maxyπdx!(t) = 0πdy!(t) = 0πNEXT tππt1 = 1                                     'some constants-for speedπt2 = 2πt5 = 5πt4 = 4πt6 = 6ππg! = .2                                   'gravity factorππDOππFOR t = t1 TO numπPRESET (x!(t), y!(t))                   'erase old pixelπdx = cx - x!(t)                         'compute distanceπdy = cy - y!(t)πr = SQR(dx ^ t2 + dy ^ t2) + t1π                                       'play with the .98 for differentπ                                       'effectsπdx!(t) = dx!(t) * .98 + (g! / r) * dx  'accel * orbitdegradation + forceπdy!(t) = dy!(t) * .98 + (g! / r) * dy  'dittoπx!(t) = x!(t) + dx!(t)                 'calc new positionπy!(t) = y!(t) + dy!(t)πPSET (x!(t), y!(t)), r                 'draw new pixelπIF r < rr THEN                         'did it go into the hole?π        PSET (x!(t), y!(t)), 0                    'erase itπ        x!(t) = RND * (cx \ t5)                   'create new pixelπ        y!(t) = cy + RND * (cy \ t4)π        dy!(t) = t6π        dx!(t) = t6π        END IFπNEXTπIF RND > .95 THEN g! = RND - .05  'random the gravity-nice visual effectπLOOP UNTIL INKEY$ <> ""ππSCREEN 0                               'exit w/credits to me :)πWIDTH 80πCOLOR 14πPRINT "⌠     ┬         "πPRINT "⌡cott │uttle '96"πCOLOR 7π______________________________cut here_____________________________________ππ'Screen art that draws water fountains.ππSCREEN 13π                                           ' you can specify the number ofπ                                           'pixels on the command lineπ                                           'ex: GRXFOUNT 1000π                                           'for 1000 pixelsππ'rem this for qbasicπIF COMMAND$ <> "" THEN            'checks to see if there's a numberπ        num = VAL(COMMAND$)                'on the command lineπ        END IFπ' to hereππIF num = 0 THEN num = 100                  'if not-its thisπIF num > 2000 THEN num = 2000              'limit on numππDIM x(num), y(num), dx(num), dy(num)       'x-coor,y-coor,dx&dy speedsπDEFINT B, T, Z                             'pallette & countersπRANDOMIZE TIMERππg = .1                                     ' gravityπscale1 = .627451                           'scaler 1πt160 = 160                                 'constant intπpi = 3.1415                                'pi-duhh!πt199 = 199                                 'bottom of screen constant intπzero% = 0πone% = 1πtwo% = 2πt255 = 255πmode% = 1ππDO                                         'color schemeπbf = INT(RND * two%)πrf = INT(RND * two%)πgf = INT(RND * two%)πLOOP UNTIL bf + gf + rf <> zero%           'no black-outsππrand:                                      'randomizes and resetsπCLSπdyscale = (RND * -4) - 3                   'rnd dyscaleπdxscale = (RND * two%) + one%              'rnd dxscaleπda = RND * .01                             'init-angle speedπa = RND * pi                               'init angleπFOR t = one% TO num                        'sets all coors and speedsπPSET (x(t), y(t)), zero%πy(t) = t199πx(t) = t160πdx(t) = RND * 5 - 2.5πdy(t) = -RND * 6πNEXTππ'πDO                                                'main loopππFOR z = num TO one% STEP -1                       'pixel loop for colorππ        FOR t = one% TO num                       'loop to calc&drawπ        LINE (t160, t199)-(x(t), y(t)), zero%     'erase oldπ        x(t) = x(t) + dx(t)                       'compute new coorπ        y(t) = y(t) + dy(t)π        dy(t) = dy(t) + gπ        IF y(t) > t199 THEN           'Did pixel go through floor?π                x(t) = t160                          'reset single pixπ                y(t) = t199                         ' with new coorsπ                IF mode% = -1 THENπ                        dx(t) = RND * 4 - 2π                        dy(t) = -RND * 6π                        ELSEπ                        dy(t) = SIN(a) * dyscale  'and angle speedsπ                        dx(t) = COS(a) * dxscale  'constants scale speedsπ                        a = a + da                'move angleπ                                                  'is it OK? reverse if notπ                        IF a > pi OR a < zero% THEN da = -daπ                        END IFπ                END IFπ                   'draw new pixel with color based on distance from centerπ        LINE (t160, t199)-(x(t), y(t)), scale1 * (t160 - ABS(t160 - x(t)))π        NEXT tππIF INKEY$ <> "" THEN GOTO quit              'key checkπb = INT((53 / num) * z) + 10                'brightness-scaled to num pixelsπIF z > t255 THEN z = t255π   πred = rf * bπgreen = gf * bπblue = bf * bπOUT &H3C6, t255                              'ready to change paletteπOUT &H3C8, z                                 'colorπOUT &H3C9, red                               'red valπOUT &H3C9, green                             'green valπOUT &H3C9, blue                              'blue valππNEXT zππda = da + RND * .01                        'rnd the angle speedsπIF da < -.1 THEN da = -.1                  'see if new speed okπIF da > .1 THEN da = .1                    'dittoππmode% = -mode%π                                           'another palette changeπ                DOπ                bf = INT(RND * two%)π                rf = INT(RND * two%)π                gf = INT(RND * two%)π                LOOP UNTIL bf + gf + rf <> zero%ππdyscale = RND * -2.7 - 3.5                      'rnd dyscaleπdxscale = RND * one% + two%                     'rnd dxscaleπLOOPππquit:πSCREEN 0πWIDTH 80πCOLOR 14πPRINT "⌠     ┬         "πPRINT "⌡cott │uttle '96"πCOLOR 7πErika Schulze                  MODE-X MANDELBROT SET          [e-mail]     07-09-96 (19:15)       PB                     476 31377    MANDEL.BAS  ' To extract MANDEL.ZIP, please load/run under PowerBASICπDEFINT A-Z: SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"MANDEL.ZIP",4^6:Z&=23240:?STRING$(50,177);πU"%up()%9%%%[-%n6KbE\g:D/K;d%%0W%%%-%%%%rf%siSfRxrf,;:>Tm>evE%'r4πU"*QJI$b%A5moqJ8#mT7in,>bCSfe'G+=)12YsR(s7wrLwXk.H8%<(+QNRv;]l=>CπU"/_8*SvSd#6cWBTmDgKdT(hPHfsIY(k&^<l?PaH2crPZTZaL^<.>:7B9^MHc2p&(πU"=]6hhT-=8:t2ns#?GxEAF4W\?XiDD-RQUSu8dy;[c*xUFZN2xi_.(T>vVTJsstWπU"'XG25blht^ENLjLWjDgd-lH'_$DCS&D7\r,ZaSCEVWLfLY&N0JOB\Lv)q^J#=47πU"Z223YEkvtmRcfK:E6(K#kOI4-(RncVX1s4P4l=U%*.8UHjxJA-W(t<)lg:C*gXAπU"0ERjy7]T0v+>mYAp'('E%^XUAlbiYnG'V6bDXKq^.bCt(Cq.r6(35nwnVrm6U_LπU"rC,':gjR94F<k4b&q<\BmKSQ7MnuY]C[*C4[^Ix;q6dQsTJI,q&NRfbcqG5EqB8πU"tpfcP&gky%,lx<V.jRL)Z'<+n;VKWL:Cg*-<ISqjob>uZ3*jZ4EfIYVMueCHvGoπU"%_R&j9v7m*JQARVlMIqCb^0*sm1rVb/lwAW9;tX^jW+DIK_5?3biQ7_BHc$^#>6πU"P'$((Kn=T#0ZTbM.)#]<0%dzQJ^d68fbLwEDynuR$JQr5$Io_C4_j>v5c[RzrxSπU"YZ+q/5j3b&27&;Q8dc>d-.;C</WbdnhSJ\l;#2E]gl,4g,62)>a'8+TPYW#y<E)πU"9;sr8VYw=$^4AetjSZUmaGi%$;.JR#L2p,('+8;46(,)8M/ZbfLa5m'X7Eoo[9gπU".88saCHQ]je.HW#?Biy):QO7IHT;oq0>'n7ePzqIt&8WxYTJtF+0eta*eM>6bH7πU"<QcA\Y,imtQ,6$/k7SWrii\-3LqXPB,T4f0#DXk#/:JMLb,,#Nb3nL'Z=b%r?k^πU"&ulb0BY1A(r\E(AY-U<f0*J<.BSmXQlrIqT3;JBnK>n_th4mPtt7*)a9oE<-W+jπU".naPQSsZRdU.l([oYAu8ATbUWAoH1qjx1>dN(hkH\-Ag0FZENt&,]gEp+.ACO9oπU"+g8mLvmdMPx<]'?mj<3q$<=6\.bdSfQ[5g''J*Y+Vrm=24gtd8fMI1PC*/-/>>fπU"ed5<fMFTDa-G=Cm)Rxx4uMzPXd?>9-r-4s^YqVoP9DP4u\VH+vC_y$4EDr9i?^EπU"#P=i*H+vhkgbcQ$MkQ>7HmO6=Ekzsd$_5-s2U<OP%4zNP8ke:vms.,)tnybQDb+πU"_WZg[;+CRd(K#vQ13$?f/e-+<W[kcTP+\D6\].c;&_[6Goc_;\%nxrQ/vcyc47AπU",QCq<WC^1Mb2CegW,umOm^'r*pq$1ZJT-CHHDs]IA[4,[x5'-AK7tOWr(7<%IZ,πU"nT=qYP8GNGR_(X%+TSLA>SFZXMU%nMhNx_?882]tNl#dElZ3%[N;=KN-TlGnfTXπU"G$xGbrd,YK%/.>E[kJlV\k]?J&ok>v\b1'?SsSqn]?Pr^JlMVpBl*xT+OPM7K\iπU"#PTu1.vPf$TN4Q5Yh_n<=mqX3j7,9kD<UDCXs4pujSiEH8W2bWBqvJ$cLxP0CStπU"'wyovPG0FBt$3#t],43N]]#AK4Z<wr,EAN])EN;v5*fi\WMu44#/Ac,+%2&,M'ZπU"l;1e'5e6xPB-UMM:Q+o\0DihyIZ:h'#07Eu201=l%<e/?DG=v#WCObGPbi2%PPHπU"DRnBBP$e%9Rr$Zu33g48rzKZ_4]ZSDhRY9Ahh%L>[prC[NQQB,]q:c>R]'%dv/+πU"kL^s7T3?OU:cA(y&B.*ev%/3;wbuF9gA7v[LG)RN[%fFY2J#-9<]R]#.5i]nDeyπU"D(4<vY*C^&s6dj>Kx;-?CCBfQ%dC5^>/erd$9N+fOVPgHJ&A*jHV2>(2*tt+lrAπU"LY*)\ip(7;K->>r2%2A$gvL#*80MM;V:vM&Xw4/mgwK'dRLc,2.hHg=EAA1ddg?πU"AtNlr>qq_)^WN#r_k3b-TY%ccuF%r3umHlG/8DMwgigAs_EKRCTsMwfE&[murmBπU"#zmJ:Pe.g-KPM^$%*z+9W&,TIvmJ9t\F/v[tum6aicJKeLosG('8-0AsVI_M]FZπU"((dae?AiB)a,zMlH/rz7W_l-KnOWb?h3](LF'b,OI_L$qce)mio1Wxfn06qIEShπU"Y3j=qcdmTc_Kg-u*TJ9n?b$mRJv$V8s7cNM:s-aHn?bKg?8Kpl\]w01?xxINnp$πU"858hZ24e'rN;cv>['\rN$.UGKJmUstahS8:Gu64(0Ty-jFnAY$Ts^SVN%<]D^m:πU"QQVCCA%UddP>)aHDxJjIE/,s44^n+U]*13(p?hjbLArSukCIvgqT0Mt>Dc+/^LUπU"F*vk9hhO[j<t'#lPAQrhX&a77N7_L?oKmrA$Udv3QVb\:jQuI<Wk7Nj7]6N0(&JπU"xsIAHC<?O6N47]vz;\U6NO7_v&5pajGUfMSG+4J\jYQu-z+c+\jYQu-z+c+\jYQπU"u-6::Y7Nj7_v6+?)\jZ;u%]cEW9RVhnO-2MAs2QkLa$IEdzr*.$Ed\<>.k&BMHfπU"hMAsF&$Ed^HK[m_JnZa#oB+rBq$K8TIEdXv(6$Ed(.AFELfM1smRG.w&BMGf,MSπU"W7*]vJHLfM)u>SMkxmi3.j,lFNjG9\$jpxYM?/F[v9a.tt,66\UE%d>\#aIAt?]πU"F+.k;b#,f6;wBFrRSv$h$SSv_v;8_)v;xD0Xjsc<72]6ph9\4jJ'uO\N7I04.kbπU"H(^fkEUdVM-nR)rB2F#\)fr^s\h=_)x1NAM)-tHH.a.dtRFK%d4hj)M/Y_)w3+mπU"7kH_'NSS$4G)d[tC\2Lr_ne(90lE%d>\#PsONY_m0)t4t?t?j.kbd^5]A<-u-IIπU"'Etlg6;ukm#mRd*1m<KLUmeD[6.jlEpBUM?MFQ3ikE%\hGq'#:0\$jxYYM?FC[vπU"9x5\h;sLNA>Kr($)x\kmmQ&N_77NoneS-Mkxi%_Ed^5a($(ck,k+hDF/v3B$[ppπU"3k8HZStVPrlFCF7+.tt-CF+.ottCFR+.kb3dHmD[^EdF[H..k5b]TGpwj80t_)xπU"m7IIedp^a^>+3ed>>a$)3Bed^a$rH,]M6\3yTk-G^:a1(fl;r$#2A<])BrnW,5pπU";B)rkb$>mZ7GX]#77O)nB..-dHH.5x^604.lbH]R?B:cu]m/'glEdg^aBbO-]6\πU",3ua'urB1R.EfMWA=[m_2n[j2j7G^__<jSE[tpg;'uApmVgn'SZMk,TYSrB$u%CπU"Z;KnJ]3tzb;ngJ]3*Z<NOf0=_g0fdt^O$:9I%adrS_OmQNI0-3%Hc.wx]950ttnπU"&g;wABQF0*x8nm[Rdj]:Vk8XLI.r2g]Nn0GFjVk$8BI\uK*/wXNgp2g]Nn,\)JlπU"c<vvY>;]0x^A6Zz]YSrB:\yA.l3L$_U(d,..*lBGFHnu9$HSqs_CqRB:]\$fkZNπU"M?F_Q3/in'#X>+?ni#6XRkwns[7,C^tmL_Kn-A?6j6k6;wBGpF0xbRomQN[_7wHπU"[t6.l8bHR?Lr/M]6S4G'*lbH>&fKUd=lfvcGPr^15:=$Uddl<H:UPr^q1+[AQ6nπU"H-rNk;w\BIFn*$^iI'edb.a.lxgFLEtMLk[\L4/lbHHR3t0DMAI2TV9_v/Cc=/WπU"lbS:&_Udr/Ec]HV0MK#I\mgnt5te9O9OnmVSSnvdPF0vL^a_))MYmtV*n0SsZk-πU"nJHp'Fgt*n0d)SHScs5JiuLLO$ERkwso/cH_ncG.n/H[v9a.$l'S38G^[K77G&^πU"a..0$lB.5x^60a.tt7^$g'mY/xB$nKZ.$e^-areH4]hk5t+rLqNMBmGEZq*GFVlπU"Q;jl4\KZwdmdjGH-msxi?;umIXIEHXtSMk,qTSrBM$;\5mUdVopSm:uT]m?tp>kπU"84HfvcRTvLH07^wddFjHURTvL^5;RSvL04gRHu$)xm7IIed\677oAn0.x,^hGwXπU"DXjwk'&A'b^h=BP98BL)Kn[1thd\4Y?>D++DXb&;x^hXg&x^h70&2d$7BIENHTSπU"SKr^b_%Udb.Px^vWY+9uk</Fj']_Ll+hD.7(2.1BoM$?Kn?/pt'NoncjR27on)cπU"j27ronL/h6'7H:DX$6=;slldGwNwmmicHpDXA6N$^9s6ouJ0u2ps3s?Rrsnt*_$πU"ZgL5rmYQiXsbZ2eVJmk\8pdhCfNTYF(rSuu;k/=EmQsi:u)jL$lppy%,,ucJCtIπU"l.?u;OSZv[<XJPDY-DoA:pp7*?P>%xn5mPTLntu%EuDedPKG:IB-cQE^2Xbb=wUπU"$P+c$my-kRMo4iQr6WYAyXTNf4ierH8q?0M;R+=eLe6gYDNiQa>?_H='\CLVfrXπU"3.D2N$%E\:=tvwo]Y[up[m1$VUsQj,wW^M>8SXB80Vke2nC;&v]3C[[1tjEjN-^πU"mmv4?'zVu518Pd(V(qea'C81q=L$H<Qf:?uIx'Er8mM:J&e<(Red%/b>#nk.g/_πU"p$3+)D/9c*,kHRK[#k,g,Y/DDPRr2:r8[:FbnMq'k];gUTBLPN]3DglFdZfrtFaπU"'O4-(jdc6>\:Vkv$&V&F+E*(:OTaL_]w5fI+cEsIx/;LP;=Hw%uKMEbLs[_HCIbπU"*l5r3G_,EBm_2Z&bGkTWw]OMcgXiq$ofwv+EbE.9NKur)hp]2NkW7l7UK7vNP,nπU".U1.pQoWoDh51;FT3**h9Qvibs-6Q,1R<tJzZO&Ece_M^'$\qy>XoWb?#$=+rtdπU"IbfoB>rDQ,se6r>RGd:V>jB5#FwtGZTY'3^(Y$.&alcrTcuIrw%L,_3/+ojsHy8πU"Oa<247hymRQB;1XIypikVkLmbprS'+[A.km\LyaYb+47Fl&[KsI:4T=\\wZx2?bπU"/$+=03?.yr7IB:VuBfIa)lKJ:Y>PsI]YTUnW#XeZGOOgfOa5P^Z#*$z1mkDH;P1πU"*ZE;jQK^hHqdTgrkmO'%0MQ,>*9cT9HmIiL<t.=O/eb$5tQMVTDiu3:5=>sZJtWπU"#ZA'4E39_Sfn+Jjsf>za&lp%aYG[ROxnyP;/i+n*\fNT%fIS73*3Fc$%-9gzz#*πU"7j7j5P>2*t#vO*SOX5_v#>tFnu^9&CS.R\V5(X,eVij7B2[&-t;[=%8:(z\;<q9πU"*X4Eq9tujr;2K_Oqg9_Y+&sDH3]rDk;=f??NSLPdBZ0<x$7I'-3<)(3VIBwYTGZπU"7da;(b7&JBu8a]mMoex5;vEOe-bJbXK.BgN/&gL6sLniJj0X(D+VXr)nzOkqImMπU"6sN-qLzh(Yh(sy:S?)]pU14HZc*Ob/U,,MA;*\:p_sN9uVvmXIvHShn+yA0I]2gπU"vjun6-TTDDxftH)?h)Hj^,sfW>IQjBvQDCeXhmTXaG#,ty+V>N2isew[W)\Vcg1πU"DKB_jeo:cR=$A=)4jd-B+4#)_JRjevOJkFNk8t)u8nC:^gEKZhc$PAc>w;P'7gpπU"r5gMlhyyz4=_82,G,hUmWT2$*H1YEXiu+w2WbT*>X[CqcK'aJGL4zo9(bzo#]lJπU"1\.f=ZBMZYb_mIamJsRfh=^)XE4^Ha_L:itE5AHS5YI0imKDp,5&.=Nd\+f/F3dπU"=P<kA_AcC8+YOMVlqEYOtfWd9^6g3MlJ9tXpw=6OKfkR9&XO,=z7Ccc<js'l#)+πU"q6JN3k]pxzU:xb:lEb:W.SpK<fTlPO3ce7KLWP3sigq.bb/:WLrtu(Bm:Zh7K3lπU"79WOHlp9OWQA.5bb:WeLru(NBKri41HTDS&r?HQqd3kfw_h(D%b6eTlPO3DULruπU"?(BmZbh7KLWP3sigq.bb/:WLrW_#M38k,4sZ?b(bEb:WLpru(BPK4i[\_0d3GiEπU"h.sL\mPWBKFi9E\1sY5MP3Esiq.5bb:WeLru(HBmZho7KLP&3CrrW_P'bY#sd3EπU"siq.5bb:WcX-Kl57(b>$2uaE6wWtlh+b#8eIr5UWP3sigq.bb/:WLrtu(Bm:Zh7πU"K6LP3CRtr?Li)i[TWP3sigq.bbn:WX'aK\c+,iEjyc7?Pv^3&rgo6K\LI/1qh2%πU"kqY1pRdDevvWW3w2QD5&vQaE'iy=0qXz:1ZhNRcP8]h#6_hzixxMI=[VtKKv.*BπU">X.ftZMS_u9LXQfq:er7gWCZ&r^hARGRdjCu;uk9bv<(n\qYh>M5h6j#WsH<sFeπU"Zd7jWN_3NZe?508+4s/F#:bE9<3TjjTnQGaA:*E=,f'D:7Bg>fg8dpr$;fX3qqnπU"IzWO$Kt_W6k/[/Z-?b%/uwR#7?G*LaidW$/3G<V)b7Uy$=yzGp$:0;EKa]+gg7wπU"&UDU5<uT$\/IYuO<VF1SmB1J*u$^ey[%U23oD0bMoL$1\zt)NxuVas+M&kO'-V7πU"WexSD9=&\#9gV*9xBpoN:p\i.z,/OE9bb<,&w?66kZ4DDq-M9Xf*oDGpU7mNQ%\πU";f#B+7/ZhuZ+4Icfe_eVPK3RkHp[=XZhNemD*kyeL^YYbnNR0hO4(h$/4c_F>H=πU"-&D-/c?Qv[,htyhObR]X>IGokq+^>wcDpH9RR3nS^u.R]ua$7-Rmb9ZfMPQlryAπU"TYsrS-Rm9_p&065)as;5k#t;67Y1*r6)1EG_xVZmhCj'WvKb.?Ln=g3Z9b+24ktπU"*HkjO>,A%EW'K2ji6w-Y8rER+=q&LUI9dZcXObS>ZCx74N,TG5WMzn66MN6tuE%πU"*u%im\',pJ:V_^xp;S8BxnOoD4*oCBz*hD9+RsA$oSO5]Zi^hc/b$Bqo4yOibfbπU"jB]fq_(NTBJQ4g%0]Wo$h+Q#J':bJ(hzDGnsf:a)l$sU3\gTk$1KG[:\=6af#pGπU"'jQT3.3ea4gV9F_=L:S#Qxn+,=\E*^t,&..Xn[t^(&qGMY(\s8CsMRT$E)=C<_?πU"e%Sf*ds-[\s3RhJRlf(f[,ORkF76,e]:UJoCM\-)D8Ec4%_XbhE7AQQok\&C\[KπU"dc=9rPLYajpL++=o,B[M>8o.\F*2qA'#1_6(KsJhq20K^>LGr[PbL7fK=h<9.JpπU"&3R(+k.?<wEi[KGSq:N\clf<TBw1I\GxZ20ke>kYMveM\_923DK>5$XoshLO/lUπU"=?eM>qgL[7+SP^DWv=wGh%LsE:FzW=U9Nt+>Xj<5e*4))b.M'P1EH0*?%l.W\R)πU"^daZVx?tmu9a\c#=Nt$<UxbsD()1V'QPD8alt.Fm>cWB^?l_IM7u:8Lbpq?vQYaπU"KjV6-A.0]n5<Q(u[Xwv=GB+ZqscNg_c.fiV6K\.cxpB5D0<E^-u]e(UH;YB'PHPπU"1c1=ePUHzu#]9LY]VbHqD6ZXfd^KkX70Q2b[39t3+K7aC7C=vfAqA%%[:P+PF[<πU"<M'i8YYCjqf;c\zGMZm%tG58bZ;Ru)dtEEIU62*HX&6VDFFv'Hd(KAZzs)p)X+:πU"3X=M'eqj,YH<'T[QX\2y\LDBF*Bh7E.q&Xa]FA5_$gh(0\m(%&Jk6QL[3ZvEYWQπU"Y-25S''S5)tJ2W*F-^6exLEw0gR/Fcj8KT*u/?nhx(%up()%9%%%#-%A6'$E?G.πU"lBr)%%%H0%%%-%%%%rf%siSt7go6y)<;xzp=MG6l6f,hQf6v*4$dAgAZQUuVfd+πU"[STDW]&<O-gFgVKX)[p1::>UZt,?JiK1Z'rF5iE3S#kqiT'>DBIW%/vW7-VC4%9πU"8yipeff#MM/SOW$+?A*TC..t5p5hZBblkipLm53f<nDZc/'mev<DnY=de^1&/x<πU";F;SCt:cfVr5<LlVjF=1h<jFm=c46Lk%87jc4v9BRPoPtrQCNJDMhhz9op9Xu[qπU"wTKtZG)\iwrG+[hBDXCJ6aUqW9j?P--_3T+PL_4^g7EDc(a3/iRpF?[BX-s1iU'πU"]'8At[#698PG)cT'(h4dO^7'S:r&,ZJJ39QcogStm;TnHjqCo+_<pI5t28z]loxπU"?_Gp[8N,Z/0huQRs$f]B5<3&;p$>7huMOSVZm?Y?xFFqUrP#Ib9TfmjPP%nJ_.AπU"G>3'g&&S,_27<*oGF,#DeL(OH&d.3oscc6(_Ju:j(G4%2_'U;/Qw:ga'M7eqKSiπU"Sto^mg0$jYRbIiImMn([.XzP5Lna4^Rlv5-\ntzD6CuMrcLne9.Uqb[I*v=%1ESπU"'x+2iMUgU3Q5p'd0[DUG$[^35eWN[6k$8P^cx^XiAnXj2B3kPBPY5v^>]OKp&]uπU"U.B^HU]S/&vU>J:Sbp.hbD3C?]6mwtPB&]p.865cH,fR9d2E]OnDhs-p'r[t*QAπU"8oT(;]Xv0B&PTBb3MIa*5gYHK?:n)GIt^W.Bd;0R(U(\;3H4]WH:jgUG-VjI0XrπU"w8bk;._tY7C]suT]c:eOq3rfoIxq2DqeT?MOO_>vS)]kU>2lj:/<Ta^RskNTYqwπU"Myy8iS0=:/%U9/jRG6?'dQ;z'Q''xxB*QP$%mY[[4_p</7$/430u(^_[#v#-MW?πU"ptVX7M-X5.dqQoKw<2Z'9lZdeaQOG;TeRKQD-G;R2eZ6E+<O6D;z-:/;<76S-YZπU":xJL//+'=)[X-X#=1c%sm1IKVS0)oH:;+ZL=[XWRUHE[8/6Zg.p8p58z1*m/WzTπU"=78v>g.6;yQLG+78('oCu#:y,tCGC/d';h0.1<)iuOzc&xB'wht(ySfz;lywG3;πU"TeK:Y\c?p27MM.M:0w[ReZ6MW?ptL.JUVs3/Au?.AC].jt5PZ=WWEX11wH3eA-_πU";af,E+8<L38]4$l.9q=DUcB1YEhv4fujv$*uZUAvrqF+$$S77tK7C,Pe$^gurYbπU"mprRH:7+#cstCKBHf1]FYC]rks]3?>k]GuDH_#jj;REtAp=OSB\ot>k\D6fKUs7πU"FbYm$(grbb.ARb.kGsthb(cg_iac\4m(jr0bd#p's*nm,n>QoS>:K^Yv#K^kxbnπU"+q:#.T5Nu>njcd+d9trGo$]Vd1;nXmhuWrv7E%3ssmTcr&a<LZdQh5U2tVAqku*πU"clw).&CG:8.iKmsv3FNHj4bu]chkZjmR*bDL_fnV(rV?WgmhXk0r(u't#D6Vl.xπU"?k4vACNFFlqqO[so9g]Fa9Bd#SBTHZjNkt;8BHHcPm$G-pp$(S1ws8TkNZEw%,uπU"p(%)9%%#%-%AH6bEIU&6Q^[(%%h%/%%.%%%%r%fsiU%SgfxN.%<>\jm5wmAIw<9πU"A_#TS6we+/zydzb05n2\1e=0c6tkj6?R3&p<?\mZPX7hkO(FKrbkvYhlhL_2hLhπU">NUjm=ra)HB<CyQJ=:B,7G=l'y#$1nm8=.>*ruf:RFs3\,Ht>3%M?4--r60k.*dπU"*6)hp>rrmOiE[U,$,?9wi)1g5iB1'8-A<X&s;fr$7/3DPT:OhNL,do:qGKB__X/πU"n-rf?M97wt2L98D(u7\yC\W?iL8S]F^UoUm:hgrPP>7;hH5N'Tt]V+rnnuAGQs2πU"4+:kevv5(qMr%[T^Db[29*\/\o]r9XrT7:djDPm.?;8Dz7,o/<2,g5(YcTMTOj<πU"\S?jXQ,bNS\<AuMYsG9>m*JpV1iewfQL?,E'dz+dy*]biMg+5W_g(G7hWQ#/:w/πU"vjD3U,3.O[JVQxfDRfgKG7XZ?r)avH7g&8_-HOD/>mj97NXCPYG+DUM]))_;pdwπU"xknf1-*/4ZA>jS<x5Vh;fM>#*I1)pxln1Xm+1G]s\a$U$f*F^J-(F$,\f+1/>?vπU"mOc/'A:d9aXn.f*k<t%T=mpiS<r]J9Ou]^[sZXcSHvjwaNL,ixUzI5I<a/^x5i[πU"yEEep^h''bAH4.t$.pExKgWm9uE7'A<>oKB&Aee7+auSVtS>h_>0ZMF;ARa]BGSπU"XSeGQ/4iruG;k_9_*L_]eOMB+C=zX-V1J9'PJ;^d09AFqEfkOpM]N,RI*?h5',+πU"<F;r?.ssEv=t3PT\uV.HMIFxVb*P>+AM&vI.*N\v<-RY:(j[ct(QCLw:kHiYJibπU"iI3'e$Sosvj2SR-I2$g<:a>d:SH-A:d)m8[5rU.[jUd;vq'&6Igc*.Zm&wkuT,nπU";b3\mUsD(wOS#>40ka6SnV%AK1$k#mZ38OvS:%Gvu/dVm\Taq45RS*Art?wZ?6kπU"_o:(?i;;gU0O#n>fhUI-3XiGqi9GB*aa0c3MqJb(ZGdl$uB<hLbbGa5H(f$H(]>πU"R8:djC:4Eavk8$uJVt/0x7&&3R2ywSvt3rct'ivCHUc2F]Ch.FGoa+m6Gb/QLP_πU".L*dvnJ2w$;Z<Xu$qXqD=NiOn9UiSpdKaA;UCY.0.?P0&-*:GYCbh3Kwg5wx<i/πU"X75H^VX1V$/SHo#H7dLQ#a66d+BAG*N8nA_\dHL(1k?eiKC[++m<u%p()9%%%%-πU"g%E*$sE>Rd%UD&%+%Y(%%%.%%%%rfs%iUSn7sh&w;,:;Up9L/I3x?$f_DCGs3eRπU"<Xcb%v-b2eV.k0Di.rKsLwltVElSRGT/mb4ZW<UBH^qP'0fo:Y%>DcI(n63i>y5πU"9&5XV\j9vEl=:$1)Rd8&C$Bp\YY&v0CfYMh6H(jaa[+LUZPFr[(FdaJ-DXY&:z8πU"Z6W9J;TlKnXR.RKfYi6#)1f$9F8Pf;p.5/E^q&Y#FK6*9\Xl<<7s]=V,+v^&]DOπU"w)k]:sA1=yFf2NPz9?:yWC44K:vFVh$.L3&Bmh0K\\3*;yZFcGRCkZ%9qNh?ChUπU":cKt)7p_,T6CL#YTQG2_=ql(\=F*9wVsDpEOL,;F:rNW$ZDv[3>.7$lQ4]36FrSπU"(ys6c:kpC)quYb/,L%'up(%)9%%#%-%U-6bE]E5T#_[(%%d%/%%.%%%%r%fsiV%πU"SgfxN.%<>\jm5wmAIw<9A_PTn6w\-UzyCysUW]1\1e=0c2tkj6?R3&s<i>b6(8LπU"Xg&.CKWbkv_hlhL_qh,_>]brt0YC&$3S4zea5Y](.$0H&N(BUIt<0S['ZwD[;jLπU"6j'*v1,PK1A.+VM/kd*d*6)hp>rrmOiE[U,$,?9wi)1g5iB1'8-A<s&3Z#JBY*,πU"c<;/9l83ynJ/KF8)Bl>UN(uE<mZYMKu7/-X(u7\yC\W?iL8S]F^UoUm:hgrPP>7πU";hH5N'Tt]V+rn.vAWQs&4+:kevjk(qL#2;.AcaU29*b/Po]u9BqV:JNjDPm.?;3πU"nxK4J;TA6aF+9NSxXOj<\S?jUQzbNN&&wu2YsG_Lc2zf9=YRvS#tY5e,Pz1\w/AπU"LAxV^NoHVXj;U3)\WOs9qCdC26&:&VJVQxfBRfgKG7XZEKHBL6XAOYm)i$4T0RGπU"/89M^:?K(4=9A.RmZJSxNGI_+SR4X?]0q90NWho/p8\['7+&PxGI+1I(+afv#mlπU"W6$*F^J-(F$,\f+1/>?vdOcE'A:d:a=n.flb<tvTOmp_f5K#7/aMkl?hi>DfcwqπU"MBobSFM%Nbcb=q)kN(r#z5De7su8:4#m?;wA'J_y8FMI8MkO%#?U\ClP+\t)<3YπU"Ep2E;uHj/>L,)AR4s+-A2/$mZf'_wu,)52>HG-3Kt9c3+4[xX-V1J9'PR;^d09AπU"FVEfkzdvAz-RI*?h4],+<F;r?.sq?tBO$oHJYK3ohU_3c?Zkw<Oc\cwhbz7VcRKπU"#54o9k8mCzJ?D7T4WWC_,xx?Dw;j#N_c&(<PI\$k1r+H1;J^kE^V9&Z6GDiEXwiπU"9$wMZj%Sl+8o+boWCC4zA-M[]T]ypY?c;uMYZ$2A[^)e/6WZ\hZKv.MS,(i5Y94πU"WDt.A<-p$w6>9,4hDfWP>'#Y%,>MP8GzDec6cOn[tj/gQ9-7a\DHtxgY$RY^)W+πU"aSVrbMhphb$]BB7cDBKaDu(wB^-S2D]a<kglFnT0wp+*;3^b2ND=nC4lp,.AH>eπU"nR&A[pDjWJU[PgIVbEZ?k]peza*0gyI6Ti;dRWvEf7=Cixq\Wi7d7XRfk__:Z?dπU"s/:[FUl_k7%:[S.&.DBQB6\30K=k%Q7q$;nG=t\lJskM;,E]_2zs[=#k_L.Db[8πU".sXMs:cIw+%up()%9%%%#-%'+]$EZp&L%M&7%%S(%%%.%%%%rf%siVS[nsh&\avπU"t;IU9Tnk(;N1%FK#+I.f.H_/*JA[Q)U[b2#?&WM\-lW)Nh,dzEbabR44FlfgFHRπU"^r_-$O&r#o6DK)^$u&uT4o.)K,ZlZ\7qL&dWGX3.Xd9Za?'9b++E0,:N1>y(vAFπU".kqZk96[:VJTX#(\Go_k*HIY<G0D7-j(DhUG>L/m3JJ2H9&S)+#q-OI)Lz+:m=yπU"pgvud3XTip>I1&JYOb%%,5<SOXQYpbf33Q6Y5%C3%mI>#jGIP[ba[lA5Bg'_dRnπU"c4bY)A+P-XA1$u(t]R2F6++uO?Tvi/Vg+XL&hix_Wck-VN\*L\e?ShZ,n(fUi#%πU"so$oIJ,D;JsNo[B^w5?ckcr_&4Fc:GBMD&wk7O-L*wcZ0DM,lf(u%p()9%%%%-pπU"%^6bdE<V%*(_(%+%f/%%%.%%%%rfs%iWSgRfx.%<T=Tk(5L[&Hw<ew&qpjl;ab9πU"f[E)9.>ERi+nYoU7OVM)-&JnOIszDrsBgrYxd?*YCQtYlhLbB5fhB$J,fLR,d3RπU"((:E4sGHP%;<-1eDVFHBLRpr1Ox+a]TnhVu:8']:/S#C<fDgYK^q5R)fa*,7*/6πU"H,qf364on-&e&g0s3pV9/E5o#bM5elTNZ15=%wNzf&,B2gpj2H_PHZ.P:,ppYeoπU".tEvUgz\p_fMcIeE-E6R&TnpD;UM.HZ4ZD]&+j9S%D*_NjFYJd0ee#>hOp<4ZpjπU"B,LBWr/;tSW*4%[G,s#ThSrZcxiqPl/Mvksb)5A;hVAyUyvG')>P8?X<*%uQx.-πU"peiOa[lRq[&S-7L3Fl>bPqjD&%E[qO?pq6?mTub#Kf##a:3W'b'>ZwIZGk&*3#GπU"6q<An07a3?jhV)8aaBA$-mRMsD-%eGPqi>zo1+?#pYkl:JQ-h'ai[c%#jQE+zfMπEND SUBπSUB V2πU"gPIj[pb34m#$SE0rIic%f#ja>u>L8Z+^X#>;J&[Z9IaT=:Izi+U<t[2?$3ox^FhπU"yT>MM/D3.\C4PHBF[DuOGNY3%r%QPg^^qakgKpqlK\-L<)PGnK9&g*0X_Y33o?SπU"[Ie^#Q%ndME6fb8^xY=WG_g7jj/cY=gPgc-PGYTM-p>+?LoYIfdZu)Wf(G9nP_'πU"b:Ru$q-d)tf+noEcOZL\*Ug#V1P$fq_V:e,cV.\['&tJNUlG=hbX]Y_:\KVBhrXπU"\R$ufjbSP6c_x?<bt41(]zpu6(s?hwj;i\e&#vWK&f8HM6aG6DaCr8tSt0p<taqπU"D+,)a6UAZZHB[/f4aSdD#'TkW2Kg]jJTdfqo'&Ig&[*Zme&wuTb,ng*e#Iv3A&yπU"<bP^+Gm(Pfh%b3dBWR]IV.-dPZ%h>5e\5,pTajq4RSn*atiuwZ6kB_o(?Ki;gU*πU"09n>CfhI-W3XBqkU9B,:aac35MGa(5ZAr:uL]p7]mCnWY$el$>;k:diY.]YFW_MπU"Hi:HCpu2f8=RzeoguW)eognFCX2d_f&9m>9FOC3X',11Gi$K<<'(FN4y2TMZnajπU"+2H]oH8>;KXZ&4dNW-'hPVXfQ387O;7]>eh6QB\7W?d5iq&e/<BElFi\Rn/j6Z)πU"-,GLCKjx6XJba*fYl\QykbqU5->Bl4W\SL[)n&=b&N(up%()9%%%%-%<p+$E]8mπU"jp%N&%%'Q(%%%.%%%%rfsi%WSnsah&wJ+s;U9MLUSN'1FK##+.6.2H/*JBAM)56πU"=#]ZD)x#(g$0Nhn<z9>*aR$4rF<h2i$kjMc2%4&\uX#J/o\pc]u#k&rO;&_dj]pπU"L$/Xm;cW;0T)\UHjo3*vECfY]62H8G&Zj<JaZ9cWRnWD-TUfq[);(q?<GGF7-AtπU"cUpjjs3R,J%:9&x;7=);H.g9:S$o*js_\Xh&:Drx?Lhu\eBA&G%[EdS&J)%8,SzπU"qDI>no;YOAYC\k\UngIWt[B+tQLFJ[UmvN;%EAP-XnGo_e6*5$X[DSiQ_R-LkFkπU"hUNUL)SSB_gm>d#\p;JR]gFWFdELf1Ptsmff^po5R'W3XJn93L2dYk3$z<u90boπU"S^<s2O9S+4U8T?scv)g,;hup%()9%%%%-%>f6bEY)Tf.&_(%%'d/%%%.%%%%rfsπU"i%XSgfjx.%T,=Tk5\L[&wK<ewq#pjla,2<fER)Y.EHRi+Y=oU7VNM)-J%nOIzuDπU"rsg.rYx?p*YCt3YlhbMB5fBq$J,\pR,dR_((:TJsGH%3;,-e_D^FBfL2p1>Ox+]πU"TTvhuk:8':R7S#6\f<q7DEKXQ+EmRYM.UW(TuE+,Btt)ZC%p^V3t=/$+-IRdhmrπU"z^4215%lwnD&L,&Af=[#7'Z_NM=NEUU)lSPeoR#/&U'c)vhr,RIoBo+9UeM-&wEπU"KjT)UK>bq6I/)[]xP/RY*8.[tZA-7mM08hbgf0G%,8Sj4QQ\7^^?_wk?B.uqV63πU"/etcdhbP^jG(zWqjkDe[nK_]p#j6D9sG.d2yAxGNmn\tQc[JVr/ayU81>(PCO^SπU"y'#)C5qt9H^_$D-b1EE?Y9'rmV'Z&;JE8hX/9t2+__Y5-H[nYb]rO%ie?Iu&l+;πU"I#6T.-.#Z]'5,\/e];s>,aM9LRbS;U8,2k$cJT9hjETuXA#&.R'OyLb(SaQSbmxπU"2HurWBQTT7(O?_RSEq(TP1%M:D$6P.n/rBsSoYr/vwq<s4H4p74Y7*9r8b2F\3NπU"o?GcN]Cj5EccCmfgL'r;ku1O%-pYL?L.#hLI0N3d&my-O$4kKSk'#?)UCpP*+p)πU"<r3Ex2hEuHjU+L\iB/,l(J>VT<NHAeBEM#r>qMEC-F3t9c;3^[x=XV1H+9PR;]RπU"S/2\5^0r0NM]z_)a'\Lqkh]p(=7;n6<\Vom(t5dbc,t#qBWD7]b8=h?+,c,LN\kπU"iV3RpX1QafE79trZg^:J1kv:OkDR.1mMj#$fcG_]:k-%mp;&1]?J'v5\GVg]*<3πU"OOEut9DL2OE6^Qwf3SaWV;Mz&Y\RH^NR\q_$xUMZ$t&A^)eZ/Ww\shKv._M,(i_πU"=5^Wpr.A<f-$w6u>,ph#DcM>B'Y%JM>P8G2zec6Scn[tDjgQ9a-5YDp8xgZo$QRπU",/Wa)V:rMhp<h$]B]BcDB7KDu(-w^%SM2]a&SklpnHTw0+g*3VbORD=nACl4,(.πU"HBe\.%A[5pTWJ&UPgI<VEZ?-kpez6a0gyUI*l;[dVvE\f=CjhB\WiB'7XR<f__PπU"ZZdqeI>Fg[pKr*'_XN*M3O0FisYWi2+>*mU<dK[6(dD;]cB,zR:^[&_VX>Aj:DLπU"mUms]Gqs^sar%#up(%)9%%#%-%#b,$Er(^s]N[&%%S%(%%.%%%%r%fsiX%Snsh*πU"&aftB;e5T<H_iDjK=s>Ryg=GT\eTd(E4FuRHC0C/rP:pbE0gx66LyeOOJRlr<5/πU"lNFJ>b;)fnzDz8rVQMh]x=,x'gl&O;&B_jUuDbE6$=)V2#'-#2p_Y3(_DTR9$&1πU"OT]VnG:?pf/rYsgAp?fgEw2fJJ7i405tV3(q^qC=$af0m3J22(1S)I+#mRHI)z+πU"e:C&pquwN8Zff(>5I1JY%Oa%,45^OXEQYbfu336]D5-1%amSvwKGI[8dmk3Z>k4πU"2tXFb-i.2Qz9;S'*BnwY<e?5E+Omrz3tcZ^V2-7xW.V5C]kW-V\*2L\?KkhZn(RπU"fU<%sI^fnpoubo>kw=cuCvZ]Skc_&u4F:GO?M&w^kw4,p$wZ0jDMlf%(up(%)9%πU"%#%-%s-6bE:JKOP_[(%%d%/%%.%%%%r%fsiY%SgfxN.%(>BTk5MR[&wV&Pujl0>πU"ia4I]-SO,uOS#h-ow=]f#h&Q^.fsRgw.k>.X6iDbyvobw54WkhR>7HR^AAV>E5tπU"&:b$P2z1jyaIHo1fD0wgdVIH3[F9<i/.;6$lcVCfd<P';u^qmkYQBP]A>k5Sr7TπU"_D.5VZDji/:x)X/6EjY$?X(2;,&Z3^#B>C.5&oP198u7'nYsogK_rQ&95kiS\R]πU"Iupt6SKMhGpNulLE97Es5SWW>O;I4QZC.IoljD]^R,9SY%D_NdjFJd30e#6GhO<πU"4cZpB,YL:r/3;tW*'4vG,Os#6fQu>NGhu:*cFxrC'P-]+T]Ayy#NG'>][8?<*r%πU"ux.3WoiOta[Rq5S&-7$L3p>LbPjDZ&%[qCO?q6??mv^W#K#:Ya:G'e$'ZwfIZk&πU"()3G61q<n0p7a?dJhV8a.aD_-LmRsD2-%GHkqizof1+VpoYk:JPQ-'aki[s#XjQπU")zCfMLIGj[B3-Tm$SUE0Ii<cs#jta>>lc8Z^XI$>J*9[:IaA*#IzBi?<tr[2$3BπU"oxFhjyTMMT/D.\kCpHBN0[uOgGN1%9rkPCL3^akG=LqluK<Lvd)PnLC9&*0kX_3πU"33oGWI*e^Q%LndE62fb^xTY=G_)=8j[bcYgPogdPGRYTWoq>+Lo9YMdRYu)f(3GπU"A]_u'bFHoWX&<[c*JR>rqMqa\g->_DZj/SZg'(0GgMZMY2de,s9]8V6u\Otj(ibπU"3>GF[q5n0#Mv:nxChu3vB$<(]nzp6(Qs?wj5;iP&X#vK&rf8M6saq9a/CrtSBt0πU"<tQaq+,p)aUAnZ:B[^/faS'.D'TLkWKge]jT8;cq'&6Ig[*.Zm&whuj<n4o*#I)πU"vIuyGv$D4-j5ySnV%AO6T8#mu38O(n:%WFsQ#4bL0HgEX,.0Guowv<X,^Fd:+/hπU"RdU2>N/aWQW4n5C8Abj2P2f5HGTNbukCJJ;$dlPuB<hLbbba5HRo$HR]qRN98jAπU"94EjvkYllawBTMNPzOTeU64lRfbg*apPF9((a0AOhaCX#*=?gjWsT^S+hw^Cw/vπU"L;bY3;:mfL:KYr7f<HM'766Wz;15)BEKKJK+BXWHU)bJ3aYOZj<(OS_ie]W?%#cπU"\HI;.5lRta[vBG'LHB/O$V]*zLjU2Hlr8^C?.'#>dl.DbN(%up()%9%%%R-%L,KπU"$EDK'u\N&7%%S(%%%.%%%%rf%siYS[nsh&\aft;de5TH+YZdq8Wn:ypgqj?,P/PπU"f0Cgok:a=bkcP'RbV=TwJDvz'x.i4E3>jRG\Hh6r9J.[&<NDm\w*Xnu4Nw,d)trπU"RSOdjUpL.s:$)EvT#CJ)R*YmY&v;CfYM62H(#cWjQJaZ9c:Tk_hD0VVo[)7>u\<πU"PGD1-dlDhI^GL[m(3J*j)yT)+%.TfM6Q_+NXCPp52wDL$-QX1+E1JYy%a%,5_dOπU"XQJYbfyZ76[I7v2OmVErklUngI_>[BK^2FBng3K:*R+QT-gbk,B]q(PR2HB+[utπU"H/tZo^V22]xW._kCek-PV\*LDR?Fh<_n(fQ)9%s6_oIJ3,;JsbNSbCZvZ]kjc_&πU"43]/64&jPyH<MVrB=YiT4>jGo&%up()%9%%%m-%&69bEiy6rl$(7%%f/%%%.%%%πU"%rf%siZS[gfx.M%*>r.k9M3s7xZAPyPfit,T2Aqzd.;qGaK>8OUWrZt?[XFXB%-πU"r9\,8*7BX&^\yyN;hVE^Y67lls>G>bRqt0C3&2vjYhh[aD38&F8(3^b\U]p/bS[πU"Aw6D[;Lr6j'vG1rPgF1HL&4q7Ea[X)di.QY.*)W(adT-<on(-ecg8B3p;-7fEeQπU"0uG]D5z#'egcGPrPdgHK]S<]7b(_zWP=EinU?SP,Uo#/r%icqn0r,v*9E4+.9)-πU"%pX>^Gef2b4q)o9/7?[hPj/Q*8pZ[DI--7M0l8h_f+pG,H^STQQA\7^?ja5giX<πU"xZiF0TwnWCB:A(h6;E.xvl_D2l^]_8cl+YiwPI)R9On;Qv<X0/_#i]\B:pp)=O.πU";q[kW0#6l?6\pfA0lB>m1/J2r8AQsh<P?3;)_$iU*.HSmIm7<u$?wsk&KiGEUZaπU"?HXv[&Wu;(SZR?AXR%#*l(3K/XP,Y,3<>0D'+WRla<kYp_gGah]VAgfPy',3<nsπU"?^HxkU$KhP3e,PTPe,Cq2_-=C#k<Yq^ldS1tT3wb4tvR\My[Kac]JT^ViAkWeX*πU"52*,J]^cYX3.pwDo&^t48*%Gs75+_SJqibbSf\Va)+d+%I4zKmsmkD#9^VkFR3JπU"a;Nu:2'VPN'k8be8fXRQqTTYb%0g6;/:^/z^9RgqFMr_m8Ro%NMnDi>v53\#lM'πU"8)Q-<jMYi^OQ^&rI]w8XDB[x#&5_3Q]+Zc8+?gTKlelEqbCfW.uHMwqWky##1zxπU"FzBX=zbBncU/W&.3yLb\yfAJD=lW'xMt>NZ55LBnxZCek>(07K8y$[Ql4oo'Y>^πU"-p,\70vZT2tw:%0-b4fO2KeciBE&7^w;AB\xC9NHr^l(daTdDmF%+nU3>ebuo(NπU"d29OFxiD#>3aggLfG-^RmhLGNxLfHBt.+]G0jqF*.2s[oqm7TV=\3vhY2t(mmAHπU"4dv$jPj]iJY7u2J&I4aIheoBre[H9hDiTCl?>B=58[au1xUm>.[KLJJq>(5E4sbπU"_G7pA9d%s']Y5<VAUQV+.6G8\j0P_8^,yg8^jsIbVU6tX;X17i3iWnPUiWptJg>πU";VCI*0.?#,E5*:7U?^1Dru:Po/;f4HqJYeHF_gjQ8dU8^qxQ.=#eW'ZO#G;NnKsπU"hgu]hrV#;>8?H#;[m8&%up()%9%%%#-%t-0$Eyh%9YO&7%%S(%%%.%%%%rf%siZπU"S[nsh&\aft;de5TH,_iDK<=s>y#gGV-4]IEJ^m(-MbW#RVZaCSaZV&INHh-O_joπU"m/$W)hfKZlWTsiO4LN;9)LFln42c6:8zuJzZ*zeH6[b)s,iI:fFg+Tfk<aOGROHπU"BZEjsbgC0GCL-U+^5'c1s5k6*I$-9=\C.?ug'>8E,zaH87kIHJ66<-hAe=FP<:UπU"$E^Y;:Pti#N6gN9,XumovTFCgC\7/49&7i^Y1W/1Ht$'=T2/h<R:haEc8.X.2?/πU"a6(]<$=gxRm_&5+(DO*1F%;,+OFU$=T,%oUxdgM_GHq'Hh8qQ%>B^LZfZq%/.HkπU"nY5q$:=5E):gnHJ6;a83bSvd*^)AN]^qv^rNq=B),F+n:ys6c<ep39qfg,D6t%%πU"up(%)9%%#%-%EG*$EmW\zKl#+%%%%4%%/%%%%r%fsij%qSugOq6%N8;8PBHx5$nπU"kL*ll(^#W\O_>5SO5;kg.Iprs-d>F.&sJ5RFKB_\79+g[[keIDSsnFk1)%RPDiXπU".<(7bWYn\ndO5QsVxks?CGrsR.SU+N)D4w4DB0Gepw7O:&:QWpllG?/AxR7:XJuπU"huW$ulv7hl$7F$bF\dm2ZJh%/WF3R:kL6H:\PU#uSRR),z\Vluh'G'?_OYu%xpUπU"$h=q#I^Y=.3Zs4;L.bh,$O/2e/auS?S?*nWOeS]&5>VA>Yn82Wle90);/,h0EM9πU"VK7ZhAwUN6rVUD2MwuPT8NCNX0N7YCm9pGLX$?-MhD];?Cm$8VluR12*MCsxJ7qπU"_Rp#wrNw(>LiQEk;p:v[XDwkvS6A)CbU;F\6-w6[2;F)*J$V]>RJ*?8=B#Tj>Z=πU"wY[x+-_[_-1$Uq/oq?&9r'9)Ja)&MVxnM/0X=m.=Bp,uCa(HMEuW/_RipK=wM=NπU"kHi0BLq^P)H4A:$irg-gZG-9$/Q*SDQF=MRbhp('Az=zmV0SH<*nEcm(+5HfO.cπU"Qq1Taw:7URSeptk+hStwN)0Jyk+nK3,/kMT's<Mx3enTJ0Q5GRY:#dK<6Wp5eJ:πU"-oGjmf%B$_a^;%)f9RR;n+)/<[(S=N*TBp3v,-.yv+SFZ]kh\zACqphD9\69RBSπU"r)8A-d9.q^%Ud$(DEidfKPio)6wOiG*$<c7$RmLkZ%tp4]H>GHsyGV0]A37r7YUπU"?j$sgn]=<2AkSe8r_\IHt]jfoDZO.jc4V^CK)*35J(mkJ&p1RA:%=tK6b0Hj-W,πU"ZuV<VHT&%*kxZjV--,aL&rafNg*36=%,H'V<+]on/72A#jcJKT_o_Z$uKPR7:ekπU"\U^$D5Y$6,tRG8>dpoy?XA5bBw-((\kKn:K'K:rvrOgPD2es#l5IJna46RZ?MkYπU"[E4dbC^PcdNYFuhpPMuMMNNI*'Puquu//O[<.&5pto\8QKM?PDqCw(*S.RjsqKsπU"pknWaoLDob^_>4do7kV0E*OUp*>XeeTX7I*+(sH&>,$f64bIy,'/95K]-]fx0a[πU"7/0-/7?&>:?9#2[Rn:Up>.XjJUYM%p7-jjLGlJ9oTu'10-8V)kiGf-o^_*n7zC=πU"r\&o*lGZt/4&0gJZ8O9APOhDIgzHBDy_z'WMK;SI;L3(6.Dyx/%:(z\HxyR>xCoπU"'*;S;LmA3Nb#upByiDpy5B2ylx*c?;5FK-]pW(0c;8vm(jjg=*c&di^d7435'5KπU"sad/l7-snX.)TL<.LM3b19sZ;kZZ]PSyJ-rf0JtCwt&tZB2FuqXkA=Llf]6nSK4πU"r_y*utzX>xVk'h]<Wd#QIXXFbXrh5tu7u3Qqc+3tBcPs#.3G^mb/oy+O^LkkphCπU"r0fbf0HdUtLO=mVlEOxxR4Fx0Vm<s<o%XxhFti75sghN_xx;R;cH.'tLB74UnfhπU"mIFu2%KvA3x*q4RDlefS>/[D9<RstmVF)8rwjmUM]F*:k2/SYo3BxYhj>)*X?l=πU"68^FejQ/M#zW_,tJY^6A=*xP;VGQ[(En)QJGOcwfG(^Mb#i0i6igg89;1?XFPa6πU"P0BQANCsNoSciB)8w5LgUHOSYtH=FgC:5,xhwd4nvRU2*_wd[nbovOBcnS]RD,;πU"LQCa-K1VUV87TRLr'M3pZhga>ZadQ<AKjc=R#1nS2JE=(d3C0iMZM9Kg,2Qj2lZπU"J[nUFUED==^2(5\XX85vch%iC:q(f3sHZ_<+dj(^C]>(E)2ZA[d0(FvaHWar+;dπU"k8C#>Oo(giFWifQmbxxP77lX'?KLLn2xLLPbLbU+rJVb8HQC6>9JNnA]Zt7KEbuπU"uUNMs'*mGYsoaV,G4rRi/kgUmBUf%I5pi*rji\aStK/$u#:X-CKk,2TEtcol.74πU"r\7<q[XTJ6Ds]Iud)[b6Y#mnSU-Kg<h\l5jbR/D-3uRU279&BiM3_'#acg7($=kπU"n'K,15$ueWXlo6=bvDnoh$4y#]]pMH^yVRM4jP#&U\>7#24$E/bslaBB/IxJ-q4πU"ybO]i)F;i0j)cqDy.CU-BX\FGwdeIfYuu^6ANI$6$-GuS8,%mryTJ[Pk,+=0l[VπU"bbQ,;h2e0]\zkU<c*#v;44.Q'CfCO^7AZv[z0KC7mi5$f6FRS+8TegToHLl_mmmπU"hDFl_kTRXeJo\rSfWtJ4I'x4up%()9%%%%-%?s7aE0FZ1m&&5%%'AK%%%/%%%%wπU"jfi%rjSVRxy&)).B#\MaNnyor'pMS#zCaCX3mYLw;vKqJa%=Fo&Qnu]VFr<Zy9>πU":1XL1%e(=vrmv8g#+UA)Gy.Dq8y]]1uIawn]x+d'OIMy$q?DswufqL^d,M\o:g8πU"p_QHk[n5mW-&Ww\9i'GPRB7M2;^0RSiR%YgT$i*c#jHnRD0T*lC5rjN+m'Z%xh/πU"q;esi?6v0c5moa#o[0:+aUo4O#^&?UYj91=0,B)-Ocf[^3?6E8]tk1cowoLs=dYπU"Yuou_[B[bq^)_okoW'*(\-n+GWaDG3LqpfhH5JwcSPj'aJI1W*0?jm4]DkNTVe&πU"+^s?lX+\fvKJLpBJ,hq0>wVC%M,J<,>+\lT*FmchR$rcdJ$s(KJl$uo_X<iW.YWπU"rujeFGFeBN^<JTxjgo]8ZBWj]W6Z8^:dkvbpR=M;F/42Z#4w)P#cE5Bc0x]4o>bπU"x96Lq25ihzwki:;s>U\f$#L:=OmJvsz,[Unikue_[mZfN>G,ItVQ(y]<vHusm.WπU"9hS>_Sd%mq<<F68yuq%[Jx+$/$l0P)wcP#hp)8V\:)PH_?r:S^P3592'O4L*[R'πU"e.G.X4?^<3v=J+#pUyZX3mZ+q1mgci=&t:R7//K9P7Jh+Z(Bcgh0$IBF;it*mo)πU"2cmi++8n$2bSHe9IZDLRg\UCi>1vC?-s]V-miIs&xuv.9.q9LMvdn1$4$.Q;ZCPπU"aEl>t'O9Ugem+^RZCYY9,SxdIGHMw8oZvwSAi;t#CIm)sFT5WI'EImU5eG>1>OgπU"S*(GW%.]+friJI]^;fW0z=.'nK/AA7ktY7C'0bQ%2dY,IHvYRBZj'lVF.J)cGKjπU"NP]GVI\huhV>7:Ft$jmeL_gJK0NLR*jG1*aSIdj(7\4f$sAA^Nn%dFI-xPv%0D>πU"^&6.oh'[bI>3a3+f5>[baU8wCrGn_T=Zxt_/%YbQ%HNL+Fd7ztm:7T-wCY#,Gl<πU"QrWYy'm/A9I&0:j);1pi*uE^e)hC#UZezYC$971^UZkYe=470kq9yJ[iU/+JgJBπU"'+gG->zdCzA1;OpeiRYvRTIRES]mc5#09)sE6&sUaxhjL[n]b44bqCm8mmHCkYfπU"7Vm-RZ9SC[H+V8tMV_2Op]jO'Tx\S>>vev<niQ\5O\&SkWhm9k5-1fx\VJ:9js2πU"C3/QmO,(]&W-nJ/#bYp6WBp0#3'IqGdZ&A=f'c-qAu:(CGW-%)No$IJ,#/L/EcYπU".>;O=H+^VelT'%$\$>Rvqeia<*Bn7nkVDmUXN<YetnCsQf?XY6NKiQKrbntDY:wπU"J2If-nB.>?A==*W$xM%W<r&=g)P5PH_saVt9jGu0>Nf[=udB[,Iq?o#Ti8p\bjeπU"K1%$6^h*fu8NxO*'\5rhlK-,\oN?n3.U-4RIot0n^UY,$/(%H_$rdrwr2R\YJ]?πU"(1cg#MMq5^QjbZ\\,$\.fqiYsa-eV0Q:G$>2GSmBxKUUl5gds3hf6aSK7WB:NABπU"^n5VcMBCB\z]E,/-iDT]-<prI\iq8p/wM6;1&;J0'Vj'^;w.0+w.4t3l[OKh2[WπU"g#UK;HJ4WEM/l5.#^9G1P>3KJ]aQgVoCSUA)06uiW,)K3l^]SxglZ<oeH4j-o/$πU"C(;t*uE]e-s.FZWEwF/IYUx4;D$dXQ/uQ4*JW$IXO/I%Y_xv6G]V1sBg-+/[&frπU"bZ:#SM%/M2dugv5$3fn,3'OVDXhCr#X1x;4JHkS^h5KgKQGT]8F$+NI=:KCk2AQπU"y1nF(&2_v3Q>phP]arh&uuZsF<^q>Q>:kC07jUu;Lqm*SSoVZ5vq0+Nulnpur.;πU";-8.1wfuh'/v^/;P]$F5XZHT,_m&lW,TetabEX0r+X<+HR\5FKuqGbmA96Q(GQVπU"',JowU21r_5S)yXQ0i(6M'm-LBobx+bf$>:D%#g+z5<\XFe&aF]kdmh[Rko[CR/πU"LG%)qC:okvRHtt37DLhp'rhGcI&.N(&yCV88TVKu?$yn/H/%([t6+$JwT][DIDgπU"lG,d).zQMYk4lY%8cbPoMA*o1KAeZ6C_wy,(pZ17g/3K?k$)D&UosE8q2<-\%]nπU";1Mf6&;V&UDoP%a]c6URg])tb97GR.Fcer7xI/-B9'sS2;RDp'gySaGTl&ugL>RπU"H0kG+pi%k40wseSO#>IURT^wIGweXaPk1p2wt]jW?U+GdB'8$Jae&y8+.Cn\v0PπU"U&YvHbVeub)Vl6HM4tSO4[vB-p3,?+]+a]5_*r^3F5j7IZ(*(Ncndwx,o09;X>iπU">[^Xwr<CV%Z_(SadO*C2dx-)d\Qua/^..G6:U-u$Req839kH2+XtOJn:+5)Ht$7πU"+I^=]<fe]Iq+ND.JfArW/paZATn3XYPtqqw-?117-#\85Y3/5mXJ^Av*^U:fD9'πU"-QI5J+F/Zkdu)h%E#FJ6k+'xUP2)6%zp(neCZ%7pkLNht4X7#T&3t]A>eqm#s7[πU"3XcH\Er1J7L.GS*(>^nBe;70bKNm$3YBvaYvv3:#MXw-2%<w:sgRW[)RDQg7B#XπU"%_6+o5W<>4kP)),*L[#'D93gNXVmPdtn78P*Q;#NRH&$>Q:AKJ#,_G0)?F&[?P<πU"mWTdF-Ih*$l*\m29rk#QI)ABC==qNK8fb/n$xp\80]8irG-eNA_h'9LYq/X6iWyπU"C*&lRH$*=\GQ8b\0N\+N5&Cu6$SC3'=$8g]epTd\%1?omM?:(yk)B_oOP\p;CqHπU"l<=4l-R4gVe]S[jZbf%uWWXHhq<N&eld#NYaFtHOCO0QRd68w)$Ma'g.*:;\mmNπU"T*p,<I?*PT2v=P+EjE6+tY'x'151hVsWgLDBL:[jSE)k_[uz*16^5hCoZbVdx4JπU"_Fqm8%abB?>[[#3Y0MFTF#A^py1T=sX#r<G'3sZPMoHK<O-xj)2&E(S]0aMrVupπU"e;LMrFVHg[LY9BuP'#I)ZJ13f/-'r<HIJHWSlr#D=36T_t%L%i\soh]n)tWkz.#πU"h;$6POVhNt2X/^(\8xq\#6KJI8rJtV?.kKneJT2R1_NL):P2N<(?HYHA>k9?ewbπU"Z&F2pGL/WZc/=pL/qJdrXkYd<l2n.D$RFSR1BXd#ptBM9Yr*,UukRZd7*>Bag?%πU"fSCo]nuNm2$ekrJcA6:dNM.lN?_.QQ0pegG6B8)9\aNU]?w$H]/^B#-msL:+xBWπU"NpD_4R%ukI(IP+WA669HbYo&B8-[1/*>nfa/P*'cfA+z540cmTBT<^6u6cMZ$-2πU"dDGEQwO-?#A&v^N*3a\$KOSLvDXAFmL^3'Ao6?eFOw%fkQG0^3t7pPRJw_l*LujπU"FPLR&npPmTgZnY):xD<J/,>Quhm#RA/4nropCI=3S^pCq4Tx'7BuwPA\K[3ggTDπU"m2<.cE#6+<2);88WEtCB#[YVfGA0csVg%Cfag5-H3N&W;47kgVWDO5OogtWF:G#πU"85ieGh?e:rczBgaNk-;DspF)415=R%o>p(T\j\/eEWRbhKm6Mdl89PaF;*FNLsqπU"WB,hR$Alb_986XUD,lE&Knb.0]^*;uIg:(QJeAiyjhzoCZ/VkKnMGa$fRVv<rLhπU"aT$nt$gxF._oG-:&XOEFi,A4QR;.^s3HEReg.yt+SCL=n#cUADb/ZCw[.V3O0E6πU";]WNi\ywnp.0.whUzpg*qB^A?/pvtA29;Z4)SdGI^p53OP3fDr<O:G<qLrJKTqLπU"^xc7?>$9RA2c=4r):,0P%*(:CP=K^6yJ79gQg+]^g\phHO(s1NX[Y]QhCId7052πU"HEuo6:,4jV<c4rV2Qn_/(wm2bRB5?FMe*,uHW::lBux2-omI2]+40o)W/&w]Yd6πU"c09OYenQ*i==cwA3r0'P*R[CS0J>,]5b7M+2gcmoaBP_jdkeF#I8)aZq.(5ER:#πU"PY9JHQ#l^k8$/,F,L8O3\_R*;S[OuMJUi+khl7Dx9Cop0^35_Mq;ddFva7IE3,\πU"*.a__I3TC+N+:m2%7nV1,6I=vPP%:ccM>M4UD[1*JM9[/N,ai#lZgw02;y.x?f?πU"BX7MQSK->/=*QKQEfa*LU,giYD#K&N9qERMnRH7.fe(<yvao3lRlo%v&kGRcc'LπU"u>P9Uuah/[0NP^hNQULgEdppRwPcdeb$u%_jqb4\,US+,=0W#%<G6\32RSnn,0VπU"E3m(%c_GxB^B$ul)_pfW_f=ar1*AU?$T0,NE3f?4u#[WPT'\^j)RS1JcYv+9$8VπU"m4*YSAllNCbPzW94MI8>6nUJH3%jJ6pzyBMPY5I((PE$RJJUW'YW2jv1gt^h8E1πU"^aQl$R%B<VB%#)JK4D2b'nEDQg?o?Mpzv]8E$gN9W*$o%_i6hx\pvHtEGY,rkRSπU"4a'Ca5eTvy1#Of2PHGvb.(nO4&>8Mf=vR^5XvmbHd7I1(lA+jIyVSewdkQSc3UFπU"2nMK*L_K:Spd$H.wYLa)hv]JML-*H0(g\h=K?0wtfHhrcGDoJp[0Sg]\jzk'm5bπU"=FV;9Q,E9v8h,Tfvmt%sXd%90URYGOzVWB%LQr/WI#gh:sFZpaLf()Ja#[%Ky/YπU"+2QL]nO)]\Fu%HTBx2._AU;f35s+cUt]qrs9aN=$.1\Ayo>2FNeg_=tnZ:td=w)πEND SUBπSUB V3πU"\$r8C;CmMVh:=43_uqIfe3x^a03t7Ol1b9^ANq<AGGAE#l)O.P^2jcMq*41GJ;?πU"eX$4B/_>L8GmZmFio%<C?E#6Ls7h_MIluwkvhXd]R*o<O_T^m8:*pD5;4:;T_A;πU"LZ[:rLq3.VtGPva[ruCq7TWYTJ9VH-):WJbH-gr*#C<ipXXCi;;Qg>#uYl&)k[VπU"2?'iI*i[Df)7<NKV5Z-*cQA+Zofn<ujMqXz%e'v1PQ'9Rw,qW-:7'T,9\hFJPGwπU":vm$f5OZaSG>F-Nps>Sou:d?[['-eu[s>P2HQ'E0Af&b#uWVL<S8<Cq8/XuLpXaπU"SM9G8BBRZXg9WM8s^vigHf>dXuP'f(nKP,JekqN4R^bxG6rw26(1f8hgr4zaXl<πU":,aNT8%.?6v5IlrYfRAlGp[z4-lSU,t^_Mh8t7^y[[e,-OY;J5bzQBF)vn71'<eπU"lz7qeU8AP1t1F'a,DoeZ<mNG1+l5tRHf[\\lsx?5Rb3WE1kP/p/:]mh_1*4kTLzπU"0EiAWNDHQT??ZN4TqH%'MVijEve5Cp.eN=.uJHVGeWQp#H-oM))A/_cmAR#wqP6πU"(-QHTf=]sKKTvUBJ8roa\gFdN%]?:lb(\cGr>g)G1/'gUrj,n>An=gmS]s-^a$\πU"a3$H=ZHuJX6#\fXK[V+d>_FOor#GIx.MF]wKRj7XVu_:((g8S.GHAkLf19][MuuπU"=$'kaZ1FpBSCP0NlO<TANZM.3ml>.W7KX(q^f$\1[tW^g_s.Y7ecmbCL\$x1\]+πU"fE=dl_RNu%dup(%)9%%[%-%BH6bE#ZQNCg[(%%4%4%%-%%%%x%zgxS[gfxFh&:>πU"S7m9vaOmuVj[OFTK$k=j=\q)A>+/:M*MDFzMO=epE'iPC$=Jvn$D2;YEG;;HdeEπU"Iq2VmJHL/l$E3>JCvm%CmU>iC2SIl*c''807iBC=,tYYT<W7^'.On.TRMOBTcVfπU"7G$3>1M&2=#bMbxgdH_Q'r1xDr)6q3CjKh44_C7Q?XDxo*iDInSL9dwJ]kYTt1ZπU"qe]v;htO_2U>cQi2t=Le0]TS=LH%#F3mjF)L<().L5Ou[P]FN1Cphc7OfL<gbfbπU"^RM+Bf+cRm>_77)2+AkF.u56b^m]ESS7CQf*Bo:EMB'U=jaOMchSZ*q8rBn+eg:πU"04%X=^XR^ZllmH0$W<Vi$+Ye<0'e4U8s;>>to&d=>7C[N$EQF.+N]OPX,LOXs3>πU"6;+V;:Qp+Y8UBl#FoZmPS3NC7C%:^?6Uu'o-[p8*)<%\9.%<9;d0)DwB%DF#HNOπU"Rk-)\'$9exOqZ8V+?-7%X$MYBn&%I4D?q_uN\l=H%HiIuh297)cjsDXX-Zakc1NπU"wRr&dCL^<eJ1unN':nm\R(i>Mn4>v;>V1uI&(8gDjba$cyqT_%UOKcmrq&/-'2SπU"T#^P2(EyU2%o).jR2U^7aHNQG&d-,;y54hqD2?X;0Pf8(T%W.D4_a)Gu>oyj>f]πU"dg=+T8^rfX+FwOMB;(5bVV4\/8Io^32-%%rv?b/N75r:ZWH,ss\FDE<-0-$h;=1πU"T)'m86'wHDjY?JL4';9XZ\lXg0?DU*o,3E1ps4/e5#wf%YB;ttQ]Z_%2,.E,K<qπU">d#&yXX#ebMDc2XgZ\*3n\w7b?23G\UT?3)P45W]16*fphsEV%XC(s.QFbNqUf#πU"xjlRvNSH3xnZ4=7d(u8/k:>c<(/a5r6,d<a-%3>YJvLT4)lqz>^r\%#gtoE[-+*πU"T_1\B'xR6j1X1BodVE+F5#uW#Y?OcOUFiYNMsxdZ5Gbx\hne_FtE+TYMC$JUXvIπU"hhSK^tV=rd=grlr4oYZ;gAD;FT^_>wQ71+hVZ5J9<s]5$dLTQCi.L.zxRFvNA$2πU"9(jlg9.IHa?L^#K.d)Zhqv>1$<G1gQ&sIkC:.Y%p/r<SXqn=SY'ldLh;VHQ+7%5πU"B,JJg3\Jt4$.5c(hvZ3rLF)fIGfT0EZJ:uwH5s1't5J_;4usJADL0AOcd1Ms)KWπU")RaFIdm4TDNu%p()9%%%%-g%V*$pE^Zq-TF&%(%1(%%%-%%%%xzg%xSugjz&aF&πU":8f=W?nR^Ju+</[(jpR%;Y6.R)oS-[iFr,*.7zmK.*pTkagt-:2t]=KoHPShOfQπU"x7k65.JihQ%gtaN9i\UOmfIh=\i4b<UtkflGZeGtJ2nF6;<_o=U=THL%[EVnBr6πU")F\Sns*\*7.?6C+(ahfAQiT.ya$gUrsTq9$w439=N?yd<o/A]hhFLJg-,8B<Bh7πU"IEu#S=W);_C$BA:n+D%3k<TD#;D<P;eAM+4P9rSUIZoQ9p]p.hV?+cFVz%F9j7&πU"UHTrmF45.]mp<)nj%IrEQ(Vw9&u5yq>2+gd1cI2\\;b4P\Pt.'*If/\zDcIs;_iπU"=J8+Ni5t_b-B;)=Mg9$]3F1DQ96W.[tf&g,Q\&7Fm\VmD1nA.)#TY$e3l[loWhkπU"vrZt6hjvslO8:7Pt[LdHGKnrTu^AznafpTMo<7_L#DBa;)NflX3gbq>63v5G1]6πU"+cW28&5_k4V;'o;q?GXzlP>B,$U4IhXb\aaS:6Uxmkz;lAMqA$n[u8Ro-xem6L*πU"rleRnd'_DvT.Fnp]XO8b&It9y[Y_iL]i7AB9??aEUj?<B^P-VorwgheWG,ug[*/πU"#r,\8up%&'9%%9%%%[-%n6KbE\g:D/K;d%%0W%%%-%%%%%%%%%&%%E%%%%%%%%%πU"rfsi%Sfxr%up&'%9%9%%%%-%:A6$E%?GlB&r)%%%H0%%%-%%%%%%%%%%%E%7%%qπU";%%%rf%siSt%goup%&'9%%9%%%d-%A60bEI&56Q^(7%%h/%%%.%%%%%%%%%&%%EπU"%%%':#%%%rfsi%USgf%xup&%'9%9%%%%-g%E*$sE>Rd%UD&%+%Y(%%%.%%%%%%%πU"%%&%E#%%%F%D%%r%fsiU%Snsh%up&'%9%9%%%%-%>U6bE4]5T#&_(%%'d/%%%.%πU"%%%%%%%%&%E%7%%6E%%%rf%siVS%gfxu%p&'9%%9%%%%-%',+$EZ*pL%M[&%%S%πU"(%%.%%%%%%%%%&%%E%%(%CI%%%rfs%iVSn%shup%&'9%%9%%%d-%^6BbE<V6%(_πU"(7%%f/%%%.%%%%%%%%%&%%E%%%'<J%%%rfsi%WSgf%xup&%'9%9%%%%-j%p+$+EπU"8mj'pN&%+%Q(%%%.%%%%%%%%%&%E#%%%I%N%%r%fsiW%Snsh%up&'%9%9%%%%-%πU">f6bEY)Tf.&_(%%'d/%%%.%%%%%%%%%&%E%7%%CO%%%rf%siXS%gfxu%p&'9%%9πU"%%#%-%#b,$Er(^s]N[&%%S%(%%.%%%%%%%%%&%%E%%(%PS%%%rfs%iXSn%shup%πU"&'9%%9%%%d-%s6BbE:K1OP_(7%%d/%%%.%%%%%%%%%&%%E%%%'JT%%%rfsi%YSgπU"f%xup&%'9%9%%%%-j%L,$gEDKu%\N&%+%S(%%%.%%%%%%%%%&%E#%%%W%X%%r%fπU"siY%Snsh%up&'%9%9%%%%-%?&6bEoiyrl&$(%%'f/%%%.%%%%%%%%%&%E%7%%QYπU"%%%rf%siZS%gfxu%p&'9%%9%%%%-%tG-$Ey%h9YO[&%%S%(%%.%%%%%%%%%&%%EπU"%%(%_]%%%rfs%iZSn%shup%&'9%%9%%%I-%E*f$Em\5zKl+.%%%4%%%/%%%%%%%πU"%%%%%E%%%'Z^%%%rfsi%jqSu%gqup%&'9%%9%%%m-%s79aEFZ/1m&57%%AK%%%/πU"%%%%%%%%%&%%E%%%&ue%%%wjfi%rjSV%xyup%&'9%%9%%%m-%B6fbE#Q6NCg(7%πU"%44%%%-%%%%%%%%%&%%E%%%%Jv%%%xzgx%Sgfx%up&'%9%9%%%%-%;V*$Et^ZqTπU"'F&%%&1(%%%-%%%%%%%%%%%E%7%%\y%%%xz%gxSu%gzup%*+%%%%%7%77%U(R%%πU"O%%%%%%πEND SUBπV2πV3πCLOSE:IF S=234AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπJonathan Leger                 FAST MEMCOPY ROUTINE           [e-mail]             07-11-96 (10:14)       QB, QBasic, PDS        204  10399    MEM.BAS     '***************** MEM.BAS **************************************************π'*** These routines were written by Jonathan Leger:                       ***π'***                                                                      ***π'***                    [e-mail]                                ***π'***                    http://www.dtx.net/~leger/                        ***π'***                                                                      ***π'***    PLEASE write to me with your questions.  I would appreciate any   ***π'*** feedback or machine language ideas for the expansion of Qbasic.      ***π'*** What can other compilers do that Qbasic can't?  What can PowerBASIC  ***π'*** or QuickBASIC do that Qbasic can't?  Maybe we can make it work using ***π'*** Machine Language routines that will blow away the other compilers    ***π'*** in speed... lemme know!  Write to me at the above e-mail address.    ***π'*** If you'd like to know how the ML routines work, write me and I'll    ***π'*** give you a step-by-step explanation.                                 ***π'****************************************************************************ππDEFINT A-ZππDECLARE SUB MemCopy (fromseg%, fromoffset%, toseg%, tooffset%, bytes%)πDECLARE SUB FillChar (segment%, offset%, value%, bytes%)ππ'$STATIC    '*** "REM $STATIC" keeps our buffer from moving around in memoryπ'           '*** for more info, see the manual or the HELP screen.ππ'*** Dim a 64,000 byte buffer to hold the screen image (an integer isπ'*** 2 bytes, so 32000 * 2 = 64000, the size of a SCREEN 13 image).πDIM buffer(1 TO 32000) AS INTEGERπ'$DYNAMICππ'*** Go to screen 13.πSCREEN 13ππ'*** Clear the screen using color 200 (sorta bluish-purple)πFillChar &HA000, 0, 200, &HFA00ππ'*** Draw some circles on the screen.πFOR x = 1 TO 100π   CIRCLE (159, 99), x, xπNEXT xππ'*** Copy the image (which is 64,000 (FA00) bytes and starts at memcoyπ'*** locat A000) and dump its contents into buffer().πMemCopy &HA000, 0, VARSEG(buffer(1)), VARPTR(buffer(1)), &HFA00ππLOCATE 7, 7: PRINT "This image has been dumped"πLOCATE 8, 5: PRINT "Into a 64,000 byte buffer() array."πLOCATE 9, 8: PRINT "Press a key to reload it."ππWHILE INKEY$ = "": WENDππ'*** Clear the screen using color 150 (sorta deep blue)πFillChar &HA000, 0, 150, &HFA00ππLOCATE 2, 1πPRINT "I'm putting this here to prove that I"πPRINT "actually cleared the screen. ;)  It"πPRINT "Also demonstrates the speed of the"πPRINT "FillChar() routine which was used to"πPRINT "clear the screen in this spiffy"πPRINT "color."πPRINT : PRINT "Press another key to reload the image."ππWHILE INKEY$ = "": WENDππ'*** Dump the contents of the buffer back onto the screen.πMemCopy VARSEG(buffer(1)), VARPTR(buffer(1)), &HA000, 0, &HFA00ππLOCATE 1, 2: PRINT "Tada! So fast you don't believe it. ;)"ππWHILE INKEY$ = "": WENDπSCREEN 0: WIDTH 80ππREM $STATICπ'*****************************************************π'***                 FillChar()                    ***π'*****************************************************π'***  FillChar() puts whatever is in value% (which ***π'***  should be a number from 0-255) into memory   ***π'***  starting at location segment:offset, ending  ***π'***  at location segment:offset+bytes%.  An good  ***π'***  example of its use would be for clearing the ***π'***  screen with a different background color in  ***π'***  a graphics screen (which is pitifully slow   ***π'***  usint PSET).  To do this for SCREEN 13, for  ***π'***  example:                                     ***π'***                                               ***π'***  FillChar &HA000, 0, 15, &HFA00               ***π'***             ^     ^   ^    ^                  ***π'***             |     |   |    |                  ***π'***  Screen 13--+     |   |    |                  ***π'***                   |   |    |                  ***π'*** Start with first  |   |    |                  ***π'*** pixel.------------+   |    |                  ***π'***                       |    |                  ***π'*** Fill with character/  |    |                  ***π'*** color 15--------------+    |                  ***π'***                            |                  ***π'*** Do so 64,000 times---------+                  ***π'***                                               ***π'*** This will "clear" SCREEN 13 with the color 15 ***π'*** (bright white), and it does so _faster_ than  ***π'*** the CLS routine clears SCREEN 13 in black.    ***π'***                                               ***π'*** Notice that the 64,000 is in HEX (FA00).  This***π'*** is the same as with MemCopy(), where a value  ***π'*** greater than 32,767 has to be put into hex.   ***π'*** Since BASIC integers are signed (can be plus  ***π'*** or minues 32,767), BASIC does not let you use ***π'*** 65,534 (64k) in an integer, and there is no   ***π'*** way to declare a variable as an unsigned int- ***π'*** eger.  Machine Language, however, does not    ***π'*** recognize the plus or minus of a number unless***π'*** you tell it to, so by using the HEX value, we ***π'*** can trick BASIC into passing a number larger  ***π'*** than 32767 to the Machine Language routine,   ***π'*** which will treat &HFA00 as 64000 (even though ***π'*** if you do a PRINT &HFA00 it returns -1536).   ***π'*****************************************************πSUB FillChar (segment%, offset%, value%, bytes%)ππasm$ = ""πasm$ = asm$ + CHR$(85)                             'PUSH BPπasm$ = asm$ + CHR$(137) + CHR$(229)                'MOV BP,SPπasm$ = asm$ + CHR$(139) + CHR$(78) + CHR$(6)       'MOV CX,[BP+06]πasm$ = asm$ + CHR$(139) + CHR$(86) + CHR$(8)       'MOV DX,[BP+08]πasm$ = asm$ + CHR$(139) + CHR$(70) + CHR$(12)      'MOV AX,[BP+0C]πasm$ = asm$ + CHR$(30)                             'PUSH DSπasm$ = asm$ + CHR$(142) + CHR$(216)                'MOV DS,AX       πasm$ = asm$ + CHR$(139) + CHR$(94) + CHR$(10)      'MOV BX,[BP+0A]  πasm$ = asm$ + CHR$(136) + CHR$(23)                 'MOV [BX],DL <------+πasm$ = asm$ + CHR$(67)                             'INC BX             |πasm$ = asm$ + CHR$(226) + CHR$(251)                'LOOP 0112   -------+πasm$ = asm$ + CHR$(31)                             'POP DSπasm$ = asm$ + CHR$(93)                             'POP BPπasm$ = asm$ + CHR$(203)                            'RETFππDEF SEG = VARSEG(asm$)π   CALL Absolute(BYVAL segment%, BYVAL offset%, BYVAL value%, BYVAL bytes%, SADD(asm$))πDEF SEGππEND SUBππ'*************************************************************π'***                       MemCopy()                       ***π'*************************************************************π'*** This routine will copy the number of bytes specified  ***π'*** in the Bytes% variable from the segment:offset in     ***π'*** fromseg%:fromoffset% to the segment:offset given in   ***π'*** toseg%:tooffset%.  To copy more than 32767 bytes,     ***π'*** put the HEX value in Bytes% instead of the decimal    ***π'*** value.  For example, in HEX, 64000 is FA00 (prepended ***π'*** by an &H in BASIC, to make it &HFA00), so if you were ***π'*** to copy a 64,000 byte screen 13 image, you would do:  ***π'***********************************************************************π'*** MemCopy &HA000, 0, VARSEG(buffer(0)), VARPTR(buffer(0)), &HFA00 ***π'***           ^     ^        ^                   ^             ^    ***π'***           |     |        |                   |             |    ***π'*** Screen 13-+     |        |                   |             |    ***π'***                 |        |                   |             |    ***π'*** Start copying at+        |                   |             |    ***π'*** the first pixel-+        |                   |             |    ***π'***                          |                   |             |    ***π'*** Segment of our 64k buffer+                   |             |    ***π'***                                              |             |    ***π'*** Offset of our 64k buffer --------------------+             |    ***π'***                                                            |    ***π'*** Copy 64,000 bytes (HEX = FA00, BASIC = &HFA00) ------------+    ***π'***********************************************************************π'*** For a full explanation of why we must use HEX instead of decimal***π'*** for values greater than 32,767, see the remarks in the FillChar ***π'*** routine.                                                        ***π'***********************************************************************π'    This routine was written by Jonathan Leger, and if you use it,π'    please let me know.  I'd like to know if this code is gettingπ'    any practical use.  I've wanted to emulate PowerBASIC's POKE$π'    and PEEK$ for a _long_ time (also Pascal's Mem[] routine), andπ'    this is my first stab at it, which worked out very well and isπ'    very fast since it's in pure machine language (it was writtenπ'    in DOS' Debug! =).π'***********************************************************************πSUB MemCopy (fromseg%, fromoffset%, toseg%, tooffset%, bytes%)ππasm$ = ""πasm$ = asm$ + CHR$(85)                             'PUSH BPπasm$ = asm$ + CHR$(137) + CHR$(229)                'MOV BP,SPπasm$ = asm$ + CHR$(30)                             'PUSH DSπasm$ = asm$ + CHR$(139) + CHR$(70) + CHR$(10)      'MOV AX,[BP+0A]πasm$ = asm$ + CHR$(142) + CHR$(192)                'MOV ES,AXπasm$ = asm$ + CHR$(139) + CHR$(70) + CHR$(14)      'MOV AX,[BP+0E]πasm$ = asm$ + CHR$(142) + CHR$(216)                'MOV DS,AXπasm$ = asm$ + CHR$(139) + CHR$(118) + CHR$(8)      'MOV SI,[BP+08]πasm$ = asm$ + CHR$(139) + CHR$(126) + CHR$(12)     'MOV DI,[BP+0C]πasm$ = asm$ + CHR$(139) + CHR$(78) + CHR$(6)       'MOV CX,[BP+06]πasm$ = asm$ + CHR$(243)                            'REPZπasm$ = asm$ + CHR$(164)                            'MOVSBπasm$ = asm$ + CHR$(31)                             'POP DSπasm$ = asm$ + CHR$(93)                             'POP BPπasm$ = asm$ + CHR$(203)                            'RETFππDEF SEG = VARSEG(asm$)π   CALL Absolute(BYVAL fromseg%, BYVAL fromoffset%, BYVAL toseg%, BYVAL tooffset%, BYVAL bytes%, SADD(asm$))πDEF SEGππEND SUBπTony Lieuallen                 GROWING FIRE                   [e-mail]      07-05-96 (16:18)       QB, QBasic, PDS        86   2053     FIRE.BAS    'Fire!!  By Tony Lieuallen.  E-mail: [e-mail]π'This is a demo I made (Evolved slowly from the file in the PC Gamesπ'Programmers Encyclopedia) in my free time.  In the rem's is what youπ'would have to do to make it run in PB (originally written for QuickBasic).π'I like values of XMax=200 YMax=100 X and YStart=50.ππDEFINT A-ZππSCREEN 13π' in PB make this:π'      (or is that ah?)π'! mov ax, &H13π'! int &H10ππRANDOMIZE TIMERπIF COMMAND$ <> "" THENπ   T$ = COMMAND$π   XMax = VAL(LEFT$(T$, INSTR(T$, " ")))π   T$ = RIGHT$(T$, LEN(T$) - INSTR(T$, " "))π  π   YMax = VAL(LEFT$(T$, INSTR(T$, " ")))π   T$ = RIGHT$(T$, LEN(T$) - INSTR(T$, " "))π  π   XStart = VAL(LEFT$(T$, INSTR(T$, " ")))π   T$ = RIGHT$(T$, LEN(T$) - INSTR(T$, " "))π  π   YStart = VAL(T$)πELSEπ   INPUT "  XMax=", XMaxπ   INPUT "  YMax=", YMaxπ   INPUT "XStart=", XStartπ   INPUT "YStart=", YStartπEND IFπCLSππCMax = 150πRed = 0πGrn = 0πBlu = 0πCC = 1ππFOR X = 1 TO CMaxπ   SELECT CASE CCπ      CASE 1π         Red = Red + 1π         IF Red = 60 THEN CC = 2π      CASE 2π         Grn = Grn + 1π         IF Grn = 60 THEN CC = 3π      CASE 3π         Grn = Grn - 2π         Red = Red - 1π   END SELECTπ   OUT &H3C8, Xπ   OUT &H3C9, Redπ   OUT &H3C9, Grnπ   OUT &H3C9, BluπNEXTππDEF SEG = &HA000πDOπ   IF INKEY$ <> "" THENπ      COLOR 180π      SYSTEMπ   END IFπ   FOR Count = 1 TO XMax \ 1.5π      Y& = (YMax - 1 + YStart)π      'In PB make all the "poke"s "pokeb"sπ      POKE (320 * Y& + (INT(RND * XMax) + XStart)), INT(RND * CMax)π      POKE (320 * (Y& - 1) + (INT(RND * XMax) + XStart)), INT(RND * CMax)π   NEXTππ   P = 0π   FOR Y1 = 2 TO YMax - 1π      FOR X1 = 2 TO XMax - 1π         X& = (X1 + XStart)π         Y& = (Y1 + YStart)π         P = PEEK(320 * Y& + (X& + 1))π         P = P + PEEK(320 * Y& + (X& - 1))π         P = P + PEEK(320 * (Y& + 1) + X&)π         P = P + PEEK(320 * (Y& - 1) + X&)π         P = P \ 4π         POKE (320 * (Y& - 1) + X&), Pπ      NEXTπ   NEXTπLOOPπAndy J. Golden                 CHAOS                          [e-mail]            07-12-96 (22:42)       QB, QBasic, PDS, PB    26   565      CHAOS.BAS   1  ' CHAOS.BASπ10 KEY OFF: CLSπ20 SCREEN 2π30 DEFSNG A-Zπ40 COLUMNS = 640π50 ROWS = 200π60 START = 1π70 FINISH = 3.999π80 TOP = 0π90 BOTTOM = 1π100 MAXREPS = 10π110 HEIGHT = BOTTOM - TOPπ120 VPCT = 1 / HEIGHTπ130 FOR R = START TO FINISH STEP ((FINISH - START) / COLUMNS)π140 X = .1π150 FOR I = 1 TO 100π160 X = R * (X - X * X)π170 NEXT Iπ180 FOR I = 1 TO 30π190 X = R * (X - X * X)π200 XPOS = (R - START) * COLUMNS / (FINISH - START)π210 YPOS = ROWS - (X - TOP) * ROWS * VPCTπ220 PSET (XPOS, YPOS)π230 NEXT Iπ240 NEXT Rπ250 A$ = INPUT$(1)πAndy J. Golden                 FRACTAL FERN                   [e-mail]            07-12-96 (22:42)       QB, QBasic, PDS, PB    26   566      IFSFERN.BAS ' IFSFERN.BASπSCREEN 2πCLSπVIEW (0, 0)-(639, 199)πWINDOW (-4, 0)-(6, 10)πRANDOMIZE TIMERπX = 0πY = 0πWHILE INKEY$ = ""πR = RNDπIF (R <= .01) THENπ    A = 0: B = 0: C = 0: D = .16: E = 0: F = 0πELSEIF R > .01 AND R <= .86 THENπ    A = .85: B = .04: C = -.04: D = .85: E = 0: F = 1.6πELSEIF R > .86 AND R <= .93 THENπ    A = .2: B = -.26: C = .23: D = .22: E = 0: F = 1.6πELSEπ    A = -.15: B = .28: C = .26: D = .24: E = 0: F = .44πEND IFπNEWX = (A * X) + (B * Y) + EπNEWY = (C * X) + (D * Y) + FπX = NEWXπY = NEWYπPSET (X, Y)πWENDπSCREEN 0πChad Beck                      PUT W/O ERASING BACKGROUND     FidoNet QUIK_BAS Echo          06-27-96 (00:00)       QB, QBasic, PDS        71   3091     PUT.BAS     ' [= As two common people in New York would say, let's start rambling =]ππ'> Wait a minute. Is the above an example of BLOADing a image? I think I haveπ'> the idea of how to get the sprite to the screen.ππ'That's an idea. Draw a bunch of sprites, use PICEM to display it and thenπ'code to save it in BLOAD format as maybe something like SPRITE.BLD. Thenπ'the program can load it in another page not displayed, and GET the spritesπ'into buffers while displaying a "please wait" message on the viewable page?π'Just ideas I was thinking up while reading this.ππ'> Now for the big question "Can you tilt the picture after drawing it?".ππ'Well, if you GET the dartboard into a buffer somehow (assuming you can createπ'one large enough) I guess you can PUT it differently? Or what about this: Youπ'scan the visable page for each pixel, and replot it slightly differently toπ'an angle on a non-visiable page, then flip to that page and its tilted! Orπ'do this on two non-visiable page while the "please wait" message is on theπ'visiable page? We may have to use the 320 x 200 mode, as don't that have theπ'most pages to work with? I am not sure on the concept of this virtual pageπ'thing, but it may be a key to this and other neat display tricks.ππ'As for animating, I heard of page-flipping techniques. Also you can do someπ'neat things with the PUT statement:ππ'From: Chad Beckπ'Subj: PUTsππ' > I think it was CHAD BECK who earlier posted how to PUT a bitmap toπ' > the screen using XOR and AND to not distort the background.  If youπ' > could be so kind, could you repost it!?  Thanks...ππ'     Actually it uses AND & OR.π'     The ANDed image (which is PUT first) should be an inverse ofπ'original, whereby color zero is used for the solid areas and the highestπ'color in the palette (mode dependant) is used for the transparent areas.π'     Here's the demo from an old mail pack.  The pair of images used toπ'draw each sprite are left in the upper left-hand corner of the screen forπ'your inspection.ππ'-----------------------------------------------------------------------πDEFINT A-ZππSCREEN 13πPALETTE 255, 1024 * 15            'Change color 255 so it's visibleπDIM Image(0 TO 33), Scr(0 TO 33)ππInColr = 4                        'The inner color of the circleπOutColr = 3                       'The color of its outer ringπCIRCLE (5, 5), 4, OutColr         'Draw original image--make transparentπPAINT (5, 5), InColr, OutColr     ' areas Color 0πGET (1, 2)-(9, 8), ImageππLINE (16, 2)-(24, 8), 255, BF     'Draw its compliment--Color 0πCIRCLE (20, 5), 4, 0              ' for solid areas, Color 255 (or 15 inπPAINT (20, 5), 0, 0               ' EGA modes) for transparent areasπGET (16, 2)-(24, 8), ScrππFOR Repeat = 1 TO 9               'Draw a background patternπ  LINE (0, 20 * Repeat)-(320, 200), Repeat + 20, BFπNEXTππFOR Repeat = 1 TO 100             'Draw the spritesπ  X = RND * 310π  Y = RND * 190π  PUT (X, Y), Scr, ANDπ  PUT (X, Y), Image, ORπNEXTππDO: LOOP UNTIL LEN(INKEY$)        'Wait before quittingππKurt Kuzba                     HAPPY TRAILZ                   FidoNet QUIK_BAS Echo          02-10-96 (00:00)       QB, QBasic, PDS        72   2907     HPTRAILZ.BAS'_|_|_|   HPTRAILZ.BASπ'_|_|_|   Happy Trailz. This program demonstrates one methodπ'_|_|_|   of creating a series of self-overwriting lines toπ'_|_|_|   keep the CPU happy when there is nothing else to do.π'_|_|_|   Released to   PUBLIC DOMAIN   by Kurt Kuzba.  (2/10/96)πDECLARE SUB HappyTrails (l%)πTYPE LNZπ   x1 AS INTEGER: x2 AS INTEGER: y1 AS INTEGER: y2 AS INTEGERπEND TYPEπl$ = COMMAND$   '_|_|_|   REM this out if using QBasicπIF VAL(l$) < 1 THEN l$ = "4"πl% = VAL(l$)πIF l% > 20 THEN l% = 20πIF l% < 2 THEN l% = 2πHappyTrails l%πSUB HappyTrails (l%)π   DIM la(1 TO l%, 11) AS LNZ, C(6) AS INTEGER, K(6) AS INTEGERπ   DIM dx1(1 TO l%) AS INTEGER, dx2(1 TO l%) AS INTEGERπ   DIM dy1(1 TO l%) AS INTEGER, dy2(1 TO l%) AS INTEGERπ   C(0) = 15: C(1) = 11: C(2) = 3: C(3) = 9: C(4) = 1: C(5) = 0π   K(0) = 14: K(1) = 13: K(2) = 12: K(3) = 4: K(4) = 5: K(5) = 0π   RANDOMIZE (TIMER + INP(64))π   FOR ln% = 1 TO l%π      dx1(ln%) = 9: dx2(ln%) = 9: dy1(ln%) = 9: dy2(ln%) = 9π      FOR fade% = 0 TO 10π         la(ln%, fade%).x1 = 320 + fade% * 2π         la(ln%, fade%).y1 = 240 + fade% * 2π         la(ln%, fade%).x2 = 320 - fade% * 2π         la(ln%, fade%).y2 = 240 - fade% * 2π      NEXTπ   NEXT: SCREEN 12π   Ky$ = INKEY$π   WHILE Ky$ = ""π      FOR ln% = 1 TO l%π      WHILE (INP(&H3DA) AND 8) = 0: WENDπ      WHILE (INP(&H3DA) AND 8) <> 0: WENDπ      Ky$ = INKEY$: IF Ky$ <> "" THEN EXIT FORπ      FOR fade% = 10 TO 1 STEP -1π         x1% = la(ln%, fade%).x1: y1% = la(ln%, fade%).y1π         x2% = la(ln%, fade%).x2: y2% = la(ln%, fade%).y2π         la(ln%, fade%).x1 = la(ln%, fade% - 1).x1π         la(ln%, fade%).y1 = la(ln%, fade% - 1).y1π         la(ln%, fade%).x2 = la(ln%, fade% - 1).x2π         la(ln%, fade%).y2 = la(ln%, fade% - 1).y2π         IF (ln% AND 1) = 0 THENπ            LINE (x1%, y1%)-(x2%, y2%), C(fade% \ 2)π         ELSEπ            LINE (x1%, y1%)-(x2%, y2%), K(fade% \ 2)π         END IFπ      NEXTπ      x1% = la(ln%, 0).x1 + dx1(ln%): y1% = la(ln%, 0).y1 + dy1(ln%)π      x2% = la(ln%, 0).x2 + dx2(ln%): y2% = la(ln%, 0).y2 + dy2(ln%)π      IF x1% > 639 THEN dx1(ln%) = -(RND * 7 + 9): x1% = 639π      IF x1% < 0 THEN dx1(ln%) = RND * 7 + 9: x1% = 0π      IF x2% > 639 THEN dx2(ln%) = -(RND * 7 + 9): x2% = 639π      IF x2% < 0 THEN dx2(ln%) = RND * 7 + 9: x2% = 0π      IF y1% > 479 THEN dy1(ln%) = -(RND * 7 + 9): y1% = 479π      IF y1% < 0 THEN dy1(ln%) = RND * 7 + 9: y1% = 0π      IF y2% > 479 THEN dy2(ln%) = -(RND * 7 + 9): y2% = 479π      IF y2% < 0 THEN dy2(ln%) = RND * 7 + 9: y2% = 0π      la(ln%, 0).x1 = x1%: la(ln%, 0).y1 = y1%π      la(ln%, 0).x2 = x2%: la(ln%, 0).y2 = y2%π      IF (ln% AND 1) = 0 THENπ         LINE (x1%, y1%)-(x2%, y2%), C(0)π      ELSEπ         LINE (x1%, y1%)-(x2%, y2%), K(0)π      END IFπ      NEXTπ   WENDπ   SCREEN 0πEND SUBπ'_|_|_|   end   HPTRAILZ.BASπKurt Kuzba                     ROTATING A BIG PALETTE SMOOTHLYFidoNet QUIK_BAS Echo          04-07-96 (00:00)       QB, QBasic, PDS        86   3329     BIGPALET.BAS'>   Can anyone tell me how to access the 256K colors that I'mπ'>   supposed to have on my VGA graphics?  I would like to putπ'>   some color cycling and the like into my graphics, yet Iπ'>   can't find a way to get beyond the basic 15 even in screenπ'>   modes 11,12, etc.π'>.............................................................π'   In mode 12h, which is a 16 color mode, you will be able toπ'only use 16 selected colors. You may choose which of the 256π'standard defined colors you will use, or even make your own, butπ'you will still be limited to 16 colors of your choice.ππ'_|_|_|   BIGPALET.BASπ'_|_|_|   This is a simple demonstration of a technique rotatingπ'_|_|_|   a big palette smoothly in graphics mode 13h.π'_|_|_|   No warrantees or guarantees are given or implied.π'_|_|_|   Released to   PUBLIC DOMAIN   by Kurt Kuzba.  (4/7/96)πDECLARE SUB RotatePalette (t%)πDECLARE SUB PalPocket (save%)πDECLARE SUB MakePalette ()π'$DYNAMICπDIM SHARED PAL(384) AS INTEGER: DIM SHARED RGB(16050) AS LONGπSCREEN 13: PalPocket 1: SOUND 999, 3: MakePaletteπFOR t% = 200 TO 1 STEP -1π   CIRCLE (60 + t% \ 2, 50 + t% \ 4), t%, 201 - t%π   PAINT (60 + t% \ 2, 50 + t% \ 4), 201 - t%: NEXT: t% = 0πWHILE INKEY$ = ""π'   WHILE (INP(&H3DA) AND 8) = 0: WEND    ' Uncomment these linesπ'   WHILE (INP(&H3DA) AND 8) <> 0: WEND   ' if compiling to .EXEπ'   WHILE (INP(&H3DA) AND 8) = 0: WEND    ' They are for smoothπ'   WHILE (INP(&H3DA) AND 8) <> 0: WEND   ' rotation if compiledπ   RotatePalette t%: t% = (t% + 1) MOD 21400πWEND: PalPocket 0: SCREEN 0: WIDTH 80, 25: ENDπSUB MakePaletteπ   DEF SEG = VARSEG(RGB(0)): O& = VARPTR(RGB(0))π   r% = 0: g% = 0: b% = 0: rd% = 1: gd% = 1: bd% = 1π   FOR t& = 0 TO 21399π      p& = O& + t& * 3π      IF (r% < 64) AND (r% >= 0) THENπ         POKE p&, r%π      ELSEπ         IF r% < 0 THEN POKE p&, 0π         IF r% > 63 THEN POKE p&, 63π      END IFπ      IF (g% < 64) AND (g% >= 0) THENπ         POKE p& + 1, g%π      ELSEπ         IF g% < 0 THEN POKE p& + 1, 0π         IF g% > 63 THEN POKE p& + 1, 63π      END IFπ      IF (b% < 64) AND (b% >= 0) THENπ         POKE p& + 2, b%π      ELSEπ         IF b% < 0 THEN POKE p& + 2, 0π         IF b% > 63 THEN POKE p& + 2, 63π      END IFπ      IF r% = 70 THEN rd% = -1:  ELSE IF r% = -8 THEN rd% = 1π      IF g% = 73 THEN gd% = -1:  ELSE IF g% = -11 THEN gd% = 1π      IF b% = 76 THEN bd% = -1:  ELSE IF b% = -14 THEN bd% = 1π      r% = r% + rd%: g% = g% + gd%: b% = b% + bd%: NEXTπEND SUBπSUB PalPocket (save%)π   DEF SEG = VARSEG(PAL(0)): O& = VARPTR(PAL(0))π   IF save% <> 0 THENπ      FOR t% = 0 TO 255π         OUT &H3C7, t%π         POKE O& + t% * 3 + 0, INP(&H3C9)π         POKE O& + t% * 3 + 1, INP(&H3C9)π         POKE O& + t% * 3 + 2, INP(&H3C9): NEXTπ   ELSEπ      FOR t% = 0 TO 255π         OUT &H3C8, t%π         OUT &H3C9, PEEK(O& + t% * 3 + 0)π         OUT &H3C9, PEEK(O& + t% * 3 + 1)π         OUT &H3C9, PEEK(O& + t% * 3 + 2): NEXTπ   END IFπEND SUBπSUB RotatePalette (t%)π   DEF SEG = VARSEG(RGB(0)): O& = VARPTR(RGB(0))π   FOR att% = 1 TO 255π      C& = O& + ((att% + t%) MOD 21400) * 3π      OUT &H3C8, att%π      OUT &H3C9, PEEK(C&)π      OUT &H3C9, PEEK(C& + 1)π      OUT &H3C9, PEEK(C& + 2): NEXTπEND SUBπ'_|_|_|   end   BIGPALET.BASπDouglas Lusher                 320X240 MODEX WITH 3 PAGES     FidoNet QUIK_BAS Echo          07-20-96 (11:19)       QB, PDS                184  5828     320X240.BAS 'Greetings, everyone. Here is code to put a VGA card into 320x240 modeπ'with 256 colors and 3 pages. This should be a good layout for highπ'quality graphics and animation. It has a 4:3 aspect ratio, so the pixelsπ'are square, and it has 20% more pixels than SCREEN 13 and multipleπ'pages. All with 256 colors. Please try it out and send me yourπ'comments and bug reports. Thanks.ππ DECLARE SUB XCLS (Page%)π DECLARE SUB ShowPage (Page%)π DECLARE SUB Set320x240mode ()π DECLARE SUB XPRINT (X%, Y%, Text$, Culler%, Page%)π DECLARE SUB PutPixel (X%, Y%, Culler%, Page%)π DEFINT A-Zπ '$INCLUDE: 'QB.BI'ππ DIM BitMask%(7)π FOR Bit% = 0 TO 7: BitMask%(Bit%) = 2 ^ Bit%: NEXTπ Test$ = "The quick brown fox jumps over lazy dogs"π CALL XPRINT(0, 0, "", 0, 0)   'initialize the print routineππ CALL Set320x240mode: SLEEP 1π HMax% = 320: VMax% = 240: Pg% = 0π FOR X% = 0 TO HMax% - 1π   CALL PutPixel(X%, 0, 2, Pg%)π   CALL PutPixel(X%, VMax% - 1, 2, Pg%)π NEXTπ FOR Y% = 0 TO VMax% - 1π   CALL PutPixel(0, Y%, 2, P%)π   CALL PutPixel(HMax% - 1, Y%, 2, Pg%)π NEXTπ CALL XPRINT(0, 0, "This is 320x240x256 mode, 3 pages", 15, P%)π FOR Y% = 1 TO 14π   CALL XPRINT(0, Y% * 16, Test$, Y%, Pg%)π NEXTπ BEEP: A$ = INPUT$(1)π CALL XCLS(0)π CALL XPRINT(0, 0, "This is page 0", 1, 0)π CALL XPRINT(0, 64, "Press 0, 1, or 2 to see the pages", 1, 0)π CALL XPRINT(0, 80, "Press ESC to exit", 1, 0)π CALL XPRINT(0, 16, "This is page 1", 2, 1)π CALL XPRINT(0, 64, "Press 0, 1, or 2 to see the pages", 2, 1)π CALL XPRINT(0, 80, "Press ESC to exit", 2, 1)π CALL XPRINT(0, 32, "This is page 2", 4, 2)π CALL XPRINT(0, 64, "Press 0, 1, or 2 to see the pages", 4, 2)π CALL XPRINT(0, 80, "Press ESC to exit", 4, 2)π DOπ A$ = INPUT$(1)π SELECT CASE A$π   CASE "0": CALL ShowPage(0)π   CASE "1": CALL ShowPage(1)π   CASE "2": CALL ShowPage(2)π   CASE CHR$(27): EXIT DOπ   CASE ELSE: BEEPπ END SELECTπ LOOPπ SCREEN 13: SCREEN 0: WIDTH 80π ENDππ SUB GetPixel (X%, Y%, Culler%, Page%)π SELECT CASE Page%π   CASE 0: VidSegment% = &HA000π   CASE 1: VidSegment% = &HA4F0π   CASE 2: VidSegment% = &HA9E0π   CASE ELSE: ERROR 5π END SELECTπ OUT &H3CE, 4: OUT &H3CF, X% AND 3π DEF SEG = VidSegment%π Culler% = PEEK((Y% * 80) + (X% \ 4))π END SUBππ SUB PutPixel (X%, Y%, Culler%, Page%)π SHARED BitMask%()π SELECT CASE Page%π   CASE 0: VidSegment% = &HA000π   CASE 1: VidSegment% = &HA4F0π   CASE 2: VidSegment% = &HA9E0π   CASE ELSE: ERROR 5π END SELECTπ OUT &H3C4, 2: OUT &H3C5, BitMask%(X% AND 3)π DEF SEG = VidSegment%π POKE (Y% * 80) + (X% \ 4), Culler%π END SUBππ SUB Set320x240modeπ 'begin with standard 320x200x256 modeπ SCREEN 13π 'disable "chain4" modeπ OUT &H3C4, &H4: OUT &H3C5, &H6π 'enable writes to all four planesπ OUT &H3C4, &H2: OUT &H3C5, &HFπ 'clear video memoryπ CLSπ 'synchronous reset while switching clocksπ OUT &H3C4, 0: OUT &H3C5, &H1π 'select 25 Mhz dot clock and 60 hz scanning rateπ OUT &H3C2, &HE3π 'restart the sequencerπ OUT &H3C4, 0: OUT &H3C5, &H3π 'to reprogram the CRT controller,π 'remove write protect from the registersπ OUT &H3D4, &H11: OUT &H3D5, INP(&H3D5) AND &H7Fπ OUT &H3D4, &H6: OUT &H3D5, &HD     'total vertical pixelsπ OUT &H3D4, &H7: OUT &H3D5, &H3E    'overflowπ OUT &H3D4, &H9: OUT &H3D5, &H41    'turn off double double-scanπ OUT &H3D4, &H10: OUT &H3D5, &HEA   'vertical sync startπ OUT &H3D4, &H11: OUT &H3D5, &HAC   'vertical sync end, reprotect registersπ OUT &H3D4, &H12: OUT &H3D5, &HDF   'vertical pixels displayedπ OUT &H3D4, &H14: OUT &H3D5, 0      'turn off dword modeπ OUT &H3D4, &H15: OUT &H3D5, &HE7   'vertical blank startπ OUT &H3D4, &H16: OUT &H3D5, &H6    'vertical blank endπ OUT &H3D4, &H17: OUT &H3D5, &HE3   'turn on byte modeπ END SUBππ SUB ShowPage (Page%)π SELECT CASE Page%π   CASE 0: OUT &H3D4, &HC: OUT &H3D5, 0π   CASE 1: OUT &H3D4, &HC: OUT &H3D5, &H4Fπ   CASE 2: OUT &H3D4, &HC: OUT &H3D5, &H9Eπ   CASE ELSE: ERROR 5          'illegal function callπ END SELECTπ END SUBππ SUB XCLS (Page%)π SELECT CASE Page%π   CASE 0: VidSegment% = &HA000π   CASE 1: VidSegment% = &HA4F0π   CASE 2: VidSegment% = &HA9E0π   CASE ELSE: ERROR 5π END SELECTπ OUT &H3C4, &H2: OUT &H3C5, &HFπ DEF SEG = VidSegment%π FOR Address% = 0 TO 19199: POKE Address%, 0: NEXTπ END SUBππ SUB XPRINT (X%, Y%, Text$, Culler%, Page%)π STATIC HiNibble%(), LoNibble%()π IF LEN(Text$) GOTO StartXPRINTπ REDIM HiNibble%(255, 15), LoNibble%(255, 15)π REDIM BitMask%(15)π BitMask%(0) = 0:  BitMask%(1) = 8:   BitMask%(2) = 4π BitMask%(3) = 12: BitMask%(4) = 2:   BitMask%(5) = 10π BitMask%(6) = 6:  BitMask%(7) = 14:  BitMask%(8) = 1π BitMask%(9) = 9:  BitMask%(10) = 5:  BitMask%(11) = 13π BitMask%(12) = 3: BitMask%(13) = 11: BitMask%(14) = 7π BitMask%(15) = 15π DIM Regs AS RegTypeXπ Regs.AX = &H1130π Regs.BX = &H600π CALL InterruptX(&H10, Regs, Regs)π CharSegment% = Regs.ES: CharOffset% = Regs.BPπ DEF SEG = CharSegment%π FOR Char% = 0 TO 255π   FOR Ln% = 0 TO 15π     BitPattern% = PEEK(CharOffset%)π     HiNibble%(Char%, Ln%) = BitMask%(BitPattern% \ 16)π     LoNibble%(Char%, Ln%) = BitMask%(BitPattern% AND 15)π     CharOffset% = CharOffset% + 1π   NEXTπ NEXTπ ERASE BitMask%ππ StartXPRINT:π SELECT CASE Page%π   CASE 0: VidSegment% = &HA000π   CASE 1: VidSegment% = &HA4F0π   CASE 2: VidSegment% = &HA9E0π   CASE ELSE: ERROR 5π END SELECTπ OUT &H3C4, 2π DEF SEG = VidSegment%π VidPtr% = (Y% * 80) + (X% \ 4)π FOR Ptr% = 1 TO LEN(Text$)π   Char% = ASC(MID$(Text$, Ptr%, 1))π   VidOffset% = VidPtr%π   FOR Ln% = 0 TO 15π     OUT &H3C5, HiNibble%(Char%, Ln%)π     POKE VidOffset%, Culler%π     OUT &H3C5, LoNibble%(Char%, Ln%)π     POKE VidOffset% + 1, Culler%π     VidOffset% = VidOffset% + 80π   NEXTπ   VidPtr% = VidPtr% + 2π NEXTπ END SUBπBen Lloyd                      PROG-DRAW 2.2                  [e-mail]            08-03-96 (10:55)       QB, QBasic, PDS        114 7405     PROGDRAW.BAS' Remember to extract the .ZIP with option -Dπ' ie.  PKUNZIP -D PROGDRAW.ZIP C:\ππDEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"PROGDRAW.ZIP",4^6:Z&=5217:?STRING$(50,177);πU"%up()%9%%%.%%:0'wE%%%%%%%%%%%%%%%3%%%%uw%tliw(f&Ti.wf&T%up()%/%πU"%%I%%=%%(F%%%%%%%%%%%%%%%9%%%%uw%tliw(f&Ti.wf&i%fySu(i&up%()/%%πU"%%%%)=%(F%%%%%%%%%%%%%%%%9%%%%uwtl#iwf&%Tity#iwf&#Sui&%up()%9%%πU"%7-%;w9vE98&7IL%%%%O%%%%:%%%%uw%tliw(f&Tu%wtli.wf&S%gfyp$/YnB(TπU"]Nq7oQGq,%ITO'Fx%/R:9^vAv9JeN#OWA(boIT%<%up%()9%%%%-%&UI&F&Er]9πU"'d'%%%N*%%%9%%%%uwtl#iwf&%Tnsx%yfqq.Sy'yS4y:='[U5bL<XNgI#<idPIeπU"8(uA/JKJOgyy2z-[Xm&0#GoSsLe6Ph[x))y:7X/oEJt>W5Y^vr1I_*&fhmi0.,(πU"2SH'A%OeR\u(z<8/$)ka4Y6b#&fPRC.c;utbb]crc9de<ZI^i74\B2AnrL(]7P<πU"d<nqE['rRD)=0CqE]-K'^)ptCLei^C_N(9pqTgcZv3wWUoer1Ht1'dAI-K3&C2FπU"(M,$^L/P::;/1gbVV#\,n\jZ%U92ow$T;l/Q;L51vk%CaW8QThA;n-6ioK$qUeuπU"0=eB^Yw%xskosab=PTfZn-p&]INO4HiB-S,')tvIEjr%/6dIJ]1g<,A*PDWM/:aπU"W_DoZsqBZL+xAdkUq<:GW0g8O+kp)Z\mN/8SxA'Pf.O56[.)'Zs,5a^HEWk\sKcπU"ac_w&CO)?DTLD&)'(XH)Upj5D5oJgF(HpEha,F>r[0mk.l/(3Gz%mfN^uGUc^f0πU"X<(Y>8=#u-NYM60d]pjoFSzLqhH&LBp5%5XG-Bk1;dj/H3:qF4*ePu2j2g.a6$?πU"g9waQ-C0]ZV)Kc^HcT>E-Hp&VY1X--OPcU)*#ak/&U62LR-6*CmQ53('l&scm)RπU"Tl-IHH3_$RP>]V9=k0X(uBW2GPKeA5h6#jxnznGCS2EIb/?6TVg:<k/<JEZGrC.πU"OpgJC[mU2K(Q#awP^6]$rOIJ(Vf1yTgqE^*RUTH&2e/uL_1DKZKOALjlRE;$2<WπU"=Xu[ndlMf'RmO>(%TD]gDlxIoreWE/0tYH-J:+51wyYE2Tu1LuA0J:)[3yAAu?vπU"Re%LiXe]YQ3$Aav<Cf_m>LfTh6FjoIUmp>B1Wv6TPMs:8X=okx3d5q<Xri?iXs2πU"oGC.xG<X_l3ZMt++U]i^1(;4hC(iM1sumTR^bkTf8$rO>G:tUW)[C-kwSAf>P$9πU"RC(8[-OYA3&yF1:;qb6Usk=x4,Gi4u%p()9%%%%-(%Uw&+F+E2&b9%%%%>%%%%6πU"%%%%uwt%liwf&&Tzx%jwSn[snX$o^W[^IW%aU#;e'WI2f;-%S%up%()9%%%%-%%πU"OI&FOt)PU&^2%%%^\%%%7%%%%uwtl#iwf&%Tiwf)&&SgRfxN*rd>T/j;x=9ox(ZπU"&Y7+QlWWM-FDObMX+vPWQM6,PL)#;JZTco'te;V?x?qD<\RNOFU>L1D,k*sl<0lπU"GHmdC_fjW>C5WLvIJ]qy<.DlIB84htqn,6Vw:BPMAyy(MEJJdqcom^+bSJscDPTπU"<VXd]Mv7kqEB;>.f#0\^?i1D3WHA%&urlm[EdMzecHky^?0#NFPzl+[8vxcPtJ_πU"'YrPjDBU'DOrlXpV[h0B'vKr$KClS&85UiVt&BadM3^Tz25H2erNSLGHpjhX]]6πU"F:><$Lcgp<T,oH1k:y[YzcFMB<Z'*5'\JQQ,<j<f7zguQ3)qQA>KQhf#XumgO(oπU"]SE^8,IgyM?E:yI\ZT&h?L.q.rJUgU/R/NL3YuiIfaD;S3t*&8%q.xAsrjo6<5wπU"T:m_D&ab09vfu493WheE4Oi-'VoTm;V/Hfn]*$IWsfbiRAaE6IN3?JrvvZ%[>.&πU"u_2[HF5U3)?WY?5S#*>^kz#,nE_=zEpkW1H)x5-lCmg's\BWOI%WfUs^%(.=5T*πU"aqm.KFo&XnYWDcb=c2+[fV$kkS;aO_0e=3cE<h#iqP)n.8PlW#nI)CaS$cfOQwJπU"<nSaPVl&+n^#+JVx9iw#+Wn7p?70_e2u?[h1<v+[HT8KL7u$9ES3;rqb1pmhyZYπU"VljN8hSSa<r[W-?SU&vRU738a(2_Y*a_X&WD>]35eMd&Qgeam+<W\)*qGZGlD([πU"5&zUp()ymZxEW2;IL;Z1B[1(/m5f%i7n9G+dmA/?rc1<swqL4rR$N_r>ab]9<BYπU"'M(Wx0I>AB%Wnu4AFzto%ChVBbII0)_25pHu..m6?h--ZhA.oG>tcek._5NAY%UπU"gy25v6[Wm,&0q8<BfomRGnla15fUEw1.XFl8rp.ToebD+qICu,;kAEPi5I;Ybo[πU"0X*V3GebN2Ybz8'pyIQ5;p3hOlJ3rfE*qB_&?t:7H*p:Z5(YP8Q,f;TrC-*g&aYπU"p:5av6jcA+TchAX=kO#\,EYWnm+x?i'o>*tx)o/NZf+ptSKpJ4502nWY.=kWpl\πU"XL4#y_.hL*KYy.wZU&niKB5T7)s5chtkhZt+pL2q.Jze%\.aqiv*>[fApNeQFa<πU"R7cH_G+]L&qCp%&[D]'7Q<P^v_&>v$<8l0I<(#&UptIAd\qgpX;aGo1J$5oH=XjπU"Egf]Od].T-62.)%hK+0ZqFD_Th.%ki[\Q_iG]fXTjoRg/N6CyD<o5_6EPq\vj>gπU"7,[Ld=r5h]\td;.c9-wKQvSlC6yTXfP.;3O\4<mJ8P\vP$pz<5-R%G1o.>4rd,/πU"*1R$c&-=X:tkIA'w,<0cSOKDg[7koY][BXdYZWaIE5l0C)bDB-;:4vi)lEqHMVHπU"zrjYDQ5CFB+jeGc,3*h1xt]'d1[^S35\f)._<kqA*?qACFbZ__mO]=Bc2Z:>''KπU"5tHsMjP'_;#Ul/$AV&jSA:6f5Gu?:CFkC6Qg1NfmiPbp\VX89sY,*wq/ieu_rR?πU"+1P)tBScMwyXt]STXrg2F(4&pZrsUZPJuidqhckDXvm_xvkhki6<uZ8?0KAAZ6SπU"AQwQMKF7[pk[uXrs51o1Xj[aO0K>m&+]?oR,^]'KHPg0qv<M&/v6.nFXOXSJeE+πU"L5bh)4g[gpM^idg*Q[f_HY*+e%Kkyy#/LJX=qeP(>^DC>I^avWgr%(O0k9YB5M3πU"X%hL1ti7g*Z$Ippz'HG'P0]JsoZnNaa9]+pKvAQ\#BL_k9Q3C>T-&?*(/jY-79_πU"d$-bQP>:/r;4WljLaM^IXBUa_u&7uANp03KtF-0PA[<.5;E?0PLLmSid6,WXdYjπU"'%/t.BC(\PR0iVzWVDrz4N.;l?fp^':'\c9&4L-uu<Q;M*_MiotPlPM/6TCReM7πU"H$&=))i)rCr'&$g\p*eqEZe:Xkuq1dRww4mJ-'sH;0sk<XaIef+JnnF%T.?ZP),πU"q1btuIBoKWRFP#\E,Ve>l51u7^/hBoz0tbjXO?(iiXf_lx[>CpNa&>[/8.BBh)gπU"(LVk[l<?Px%Y<Ly3R#NIUPefY['<<$k7*Oyu0XD1s9Q*D9zV(kt_.f^Y-PjxDIaπU"6R833>TE-H)9Igm8o/RD-++i^8y/mu396mbdzQXZm]&+w-5CDWZ-&37;d>I\H97πU"b=Jz3Zo/)Z;advkyKJZI(+(s5=t.v4t\HB#>g7q8,-+'TTuHR:m$4IHuBum'PJ'πU"M_Tz.$pey6nX&P*v5q(szVrqT[b3-=I0,p.K3]DNmXv&lRGb;lLjVrRY;5/MS1oπU"vI^]GX&(hR/E0Z9bLrZ'd[v[=7fIC.,>6q%bA?eGDCXA*qSfA-aTnG7)-=b2ob5πU"Ltqa(6c51KT:[4q%U)1ZHUJn1Npenemc,U[\(e9j'K'3-NZ_K);sN0TM'lgbsTAπU"sQ2l?r'9F^^Ilt#,nIra/lHiRDi;-:_1i'\(#lJQXVsC9#.rJ?3F?.AWIfeWYETπU"+a^kHHF#)t-g7JT0a3qze#kT&NOKkt#2W#NPCraGFcKh;RA**&x<=0sFt%PAz\*πU"GAzvkS&T)YIk,3A#w20L>%e7ra=6*?*+.;Hk-Km)3o>652eP$LI?&#:nO3*WchcπU"$JwH.q%qiVz15RCVMP?SuMW.c3^*z^Ds#69Ojo^oX&6MAFOJXwV#?J,8W;c<uX=πU"BePeJH?>e:^..-7wKsXL^c^L1=[dGJ=6)u=DT>=qX\8GRqSfB0?Z-ufcp8b;T:CπU"D,_i7o*z7li4,X)*4,*]oc7aVo')m4b,gr49>s'HW3T[j$mq7n>61kN:OMZxEAZπU"N#X4q[jjGO_V=2+sVTbo_]dQM&-k]wlBjCjq=#BRoZJ*S)cCE>uF.>M4.$?Yf,_πU"[76N9Li6xf$G6mHEc;t/ATsZ#lWnUnyR%9Dt*Ww,XaNGJC#]D70gD]u_4i_Ox(<πU"GWl$F93Ur6*9QTkQSf%F4)MH5.D;v7McFu<H_Nt%DBsv/lDzv9#Ni/TDhYunKP4πU"uP[4k^&a$S^1mV_G5)0$^?;_P*z8W(2'PK22g6\/s(_P*Sig;68d\'a2U;3qI*#πU"d;?gX&Oj+;1Y/L([0#U,k<MORG;jQI)LZ3#b5?E+D/PjVUr>X1V.7:QI+d;Ih<LπU"3s<Z*)c_Z.9b5'XQ2R1Q+/J0(.bpaAQ8>e\R^NflG?+5iAv4A,uDGfD/K=[NUe[πU"e&#VR/9+]guoW>:hPsQAc/Y/*6oeh#;Y.TF3lvP5+_q'_HDS8OSDz8O1Vi,Spx0πU"M5'p#u8^i8CITAX0pR+3fO5L6GP7X__swROwY?-g?29WvFav&:hmCllHK(FpUO1πU"F%q]0AR9R6jA7^1?Lm(tJLFdtssc'C\aSg>z3)9Kl#F=dQZdh[A8';fCPknFMV,πU"KJBl-8b4o_P=,M&Wc6%c4sVDn:S?5k]IZeX%+++=?Q9I+pk\F2aGg,m&l86dGKsπU"mZ%T?bIimp\gj#m_J'2w7a+W'H(ueT9Ia+s[ImZeP?fbOYQo9x4W.:hV:uQBNU=πU"X2IB;S;G1RI9*X/teL[e:979(KX'2]RqW1Yq3%MG,\eV69'p3^*DS8OSDz:PCdEπU"HtDdv35^:ZG6J0B>jv^(M]I-km2D\p33j,[&EnDMyghP,5M.f4?^jDHs\DHG4S,πU";d\<YSn5pkEAabp7B+%1^(/BdHLw2^kocDAK$3%>q;HuA]nm<b0<'%B#_2;'7:GπU"+0O\UB0&#'o)F<'H^EFh>4a*BNOIdN^Lte+foe]$88.U#7==g$<(>:G%0;?=,cqπU"(0;n>:app*P9MUD[;:O\/)(XD1R9/1d[Pb/U>FuAY2WYIn'H27Ju+hOJ+0_?KiLπU"C/Ms-bnB(VR93zS2E(UK:JX6)/L0;7nq%z(FXXQUzkC=5^RoGUzTTB;MU_dmhugπU"h^-jQlT+7iV?]Pqhga*Yt)$PE*hwVER,LNj6/M_;D=c\#&VMKU2Y2ipu9qXh-PEπU"fUTG0DIhnu;J8Z\O]U743swpiWZt$#K208M7v.TeMO.>Ii8H5wANSQgh<fkMu1bπU"S5a4m6E'8b<Uuv1V\#-I]uk6=G=l,w/'9VSd?7yH,x]O?^:^:MS7MHX)f>sZZ#RπU"L&aQmhjUlU9>qCmuOo^ZviLZ+&ejz*fUMFgJjPfRpqCdi%5E%ziN_M-za/'aqQcπU"(+(__Pf(S,3^#wlqbQ%<(z<<$-QviMDd>sBM'p4PF3w+FD+Qf\mgJb]Zua_%#wGπU"Q/Z(F?MYhj<*7yWQitpZ+b9vkCRaex6lpQdHLqus48g;HSq4V)(>Ed\2cup/&RNπU"gR[$v:5rh^adulZOYwmMr4h[1JJI1Nmsi:?Tv9t7>CGiuu)4g/tl*WC^]AO*gcZπU"Z5S_^7>[fH)EQr7>4KMK+;tDR8Tj2x[xSt$YZ]3F02=NiBW#4Z1tv#a^LFD;O4WπU"_kRzj<zY#3e1nncE#R<pm:]5mLBmq-ic[KO+w%4up(%)/%%#%%%>&%(F%%%%%%%πU"%%%%%%%%>%%%%u%wtli.wf&T#iwf&%Tijk%fzqy%Sgfx%up&'%9%9%%%%%%8:0wπU"E%%%%%%%%%%%%%%%%3%%%%%%%%%&%U%%%%%%%%%uw%tliw(f&Ti.wf&T%up&'%9πU"%/%%%%%%)=%(F%%%%%%%%%%%%%%%%9%%%%%%%%%&%E%%%%Q%%%%uw%tliw(f&TiπU".wf&i%fySu(i&up%&'9%%/%%%I%%=%%(F%%%%%%%%%%%%%%%9%%%%%%%%%&%%E%πU"%%&-%%%%uwtl#iwf&%Tity#iwf&#Sui&%up&'%9%9%%%%-%9;wvE0987I%L%%%%πU"O%%%%:%%%%%%%%%&%E%.%%_%%%%uw%tliw(f&Tu%wtli.wf&S%gfyu%p&'9%%9%πU"%#%-%U#I&FE[r]9d%'%%N%*%%9%%%%%%%%%&%%E%%+%c%%%%uwt%liwf&&Tns%xπU"yfq#qSy'%yup&%'9%9%%%%-(%Uw&+F+E2&b9%%%%>%%%%6%%%%%%%%%&%E%%%%,πU"%)%%u%wtli.wf&T%zxjw%Snsn%up&'%9%9%%%%-%%OI&FOt)PU&^2%%%^\%%%7%πU"%%%%%%%%&%E%%%%o)%%%uw%tliw(f&TiIwf&&%Sgfx%up&'%9%/%%%%%%)>%(F%πU"%%%%%%%%%%%%%%%>%%%%%%%%%&%E%%%%.7%%%uw%tliw(f&Ti.wf&T%ijkf%zqyπU"S%gfxu%p*+%%%%%-%%-%0%'%%e%7%%%%%πEND SUBπCLOSE:IF S=255AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπTony Cave                      BURNING FIRE SIMULATOR         FidoNet QUIK_BAS Echo          07-31-96 (01:12)       QB, QBasic, PDS        218  7253     BURNING.BAS 'burning.bas is a fire simulator followed by a palette manipulatorπ'1 compile the program (Qbasic v1.1 users see REMarks in SUB getsizes)π'  (you need to save this in QB to generate the DECLARE statements)π'2 run the program specifying window sizeπ'  EXAMPLE: burning 100 80π'  where 100 is the x value and 80 is the y valueπ'  executing burning with no parameters uses the default values.π'  (you might want to use the defaults first to get a feel for it)π'  for great palette manipulations try using:  burning 200 160π'3 when you want to freeze the screen and go into palette manipulations,π'  press a keyπ'4 in the palette manipulations:π'  press "P" for a different palette setπ'        "-" to slow down palette rotationπ'        "+" or "=" to speed up palette rotationπ'        "Q" to quitπ'Feedback would be appreciated (especially on speeding up the fire sub)πDIM ca(9, 256)πID$ = "BURNING.BAS (c) 1996 by Tony Cave"πscreenmode  ' setup the screenπgetsizes    ' get the screen sizesπfirepal     ' setup palette for fireπcircleback  ' draw circular background (REM this out if you don't like it)πrandback    ' draw random background to speed up fire simulationπfire        ' fire simulationπcolors      ' palette manipulationsπ'NOTE: This program is not guaranteed to do anything.  The authorπ'of this program claims no responsibility for anything that happens.π'If any damage is done, it is the fault of the user of this program.πSUB circlebackπFOR cir = 0 TO 255    'add this sub for a circle backgroundπCIRCLE (160, 100), cir * 203 / 255, cir / 2πCIRCLE (160 + 1, 100), cir * 203 / 255, cir / 2πNEXTπEND SUBπSUB colorsπSHARED a$πDOπ DOπ  cycleπ  delayπ  getkeyπ LOOP UNTIL a$ <> ""π keycheckπLOOPπEND SUBπSUB cycle                    'cycle the paletteπSHARED red%, green%, blue%πrgb 1πu1% = red%: u2% = green%: u3% = blue%πFOR t = 1 TO 254π rgb t + 1π OUT &H3C8, t: OUT &H3C9, red%: OUT &H3C9, green%: OUT &H3C9, blue%πNEXTπ OUT &H3C8, 255: OUT &H3C9, u1%: OUT &H3C9, u2%: OUT &H3C9, u3%πEND SUBπSUB delayπSHARED m7πFOR asdf = 1 TO m7: NEXTπEND SUBπSUB findrgb (x%, y%)          'finds the rgb of a particular pixelπSHARED red%, green%, blue%πc% = POINT(x%, y%)πOUT &H3C7, c%πred% = INP(&H3C9)πgreen% = INP(&H3C9)πblue% = INP(&H3C9)πEND SUBπSUB fireπSHARED sizex, sizey, space, ca()πDIM x AS INTEGER, y AS INTEGER, avg AS INTEGERπDOπx = INT(RND * sizex) * space - INT(sizex / 2) * space + 160πy = INT(RND * sizey) * space - INT(sizey / 2) * space + 100πavg = POINT(x - space, y + space)πavg = (avg + POINT(x + space, y + space) + POINT(x, y + space)) \ 3πavg = avg * -(avg < 255)πPUT (x - 1, y - 1), ca(1, avg + 1), PSETπLOOP UNTIL INKEY$ <> ""πEND SUBπSUB firepal               'the starting paletteπFOR pu = 1 TO 255π OUT &H3C8, puπ OUT &H3C9, (126 - (ABS(pu - 128))) / 2π OUT &H3C9, (126 - (ABS(pu - 128))) / 4π OUT &H3C9, 0'((ABS(pu - 128))) / 4π'LINE (pu, 0)-(pu, 25), pu  'This is to check out the paletteπNEXT puπPALETTE 128, &H20303FπEND SUBπSUB getkeyπSHARED a$πa$ = INKEY$πEND SUBπSUB getsizes                'get the screen sizeπSHARED sizex, sizey, hsizex, hsizey, spaceπspace = 1  'distance apart for pixels or boxes or whateverπsizex = VAL(LEFT$(COMMAND$, 3))πsizey = VAL(RIGHT$(COMMAND$, 3))π'Qbasic users REM out the above 2 lines and unREM the below lineπ'sizex = 20: sizey = 20  'change these to what ever you want butπ                         'larger numbers slow it down alotπ                         'For good palette manipulations, change toπ                         'sizex=316:sizey=196 and wait about 7 minπ                         'before pressing a keyπa = sizex: B = sizey: c = 318: d = 198πsizex = a * ABS((a <> 0) AND (a < c)) + 50 * ABS(a = 0) + c * ABS(a > c)πsizey = B * ABS((B <> 0) AND (B < d)) + 30 * ABS(B = 0) + d * ABS(B > d)πhsizex = INT(sizex / 2)πhsizey = INT(sizey / 2)πEND SUBπSUB keycheckπSHARED a$, m7π IF a$ = "=" OR a$ = "+" THENπ m7 = m7 - 1000: m7 = m7 * -((m7 - 1000) > 999)π END IFπ IF a$ = "-" THEN m7 = m7 + 1000π IF UCASE$(a$) = "P" THEN nextpalπ IF UCASE$(a$) = "Q" THEN DEF SEG : SYSTEMπEND SUBπSUB nextpalπSHARED palnum, red%, green%, blue%πnop = 5    'number of valid palette sets in case you want to add moreπpalnum = palnum + 1πIF palnum > nop THEN palnum = 1πSELECT CASE palnumπCASE 1πPALETTEπCASE 2πt = 0: m = 0πFOR pu = 1 TO 255π IF t = 0 THEN count = count + 1: IF count > 31 THEN t = 1π IF t = 1 THEN count = count - 1: IF count < 1 THEN t = 0: m = m + 1π IF m > 3 THEN m = 0π OUT &H3C8, puπ OUT &H3C9, INT((32 - count) * 63 / 32) * ((m = 0) OR (m = 3))π OUT &H3C9, INT((32 - count) * 63 / 32) * ((m = 1) OR (m = 3))π OUT &H3C9, INT((32 - count) * 63 / 32) * ((m = 2) OR (m = 3))πNEXT puπPALETTE 255, 0πCASE 3πse = INT(.03 * 127): th = INT(.08 * 127): fo = INT(.99 * 127)πFOR pu = 1 TO seπ OUT &H3C8, pu: OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, 32πNEXT puπFOR pu = se TO thπ OUT &H3C8, pu: OUT &H3C9, 0: OUT &H3C9, 0π OUT &H3C9, INT((pu - se) * (31 / (th - se))) + 32πNEXT puπFOR pu = th TO foπ OUT &H3C8, pu: OUT &H3C9, 0: OUT &H3C9, 0π OUT &H3C9, 63 - (INT((pu - th) * (31 / (fo - th))) + 32)πNEXT puπFOR pu = fo TO 127π OUT &H3C8, puπ OUT &H3C9, INT((pu - fo) * (63 / (127 - fo)))π OUT &H3C9, INT((pu - fo) * (63 / (127 - fo)))π OUT &H3C9, 63πNEXT puπFOR pu = 128 TO 255π rgb 255 - puπ OUT &H3C8, pu: OUT &H3C9, red%: OUT &H3C9, green%: OUT &H3C9, blue%πNEXT puπCASE 4πt = 0: m = 0πFOR pu = 1 TO 255π IF t = 0 THEN count = count + 1: IF count > 6 THEN t = 1π IF t = 1 THEN count = count - 1: IF count < 1 THEN t = 0: m = m + 1π IF m > 3 THEN m = 0π OUT &H3C8, puπ OUT &H3C9, INT((7 - count) * 63 / 7) * ((m = 0))' OR (m = 3))π OUT &H3C9, INT((7 - count) * 63 / 7) * ((m = 1))' OR (m = 3))π OUT &H3C9, INT((7 - count) * 63 / 7) * ((m = 2))' OR (m = 3))πNEXT puπPALETTE 255, 0πCASE 5πFOR pu = 1 TO 255π OUT &H3C8, puπ OUT &H3C9, (126 - (ABS(pu - 128))) / 2π OUT &H3C9, (126 - (ABS(pu - 128))) / 4π OUT &H3C9, 0'((ABS(pu - 128))) / 4π'LINE (pu, 0)-(pu, 25), puπNEXT puπPALETTE 128, &H20303FπEND SELECTπEND SUBπSUB randbackπDIM c AS INTEGERπSHARED sizex, sizeyπfy1 = ABS(sizey / 2 <> sizey \ 2): fy2 = NOT ABS(fy1)πfx1 = ABS(sizex / 2 <> sizex \ 2): fx2 = NOT ABS(fx1)πFOR y = 100 - sizey / 2 - 1 + fy1 TO 100 + sizey / 2 + 1 + fy2πFOR x = 160 - sizex / 2 - 1 + fx1 TO 160 + sizex / 2 + 1 + fy2πc = INT(RND * 50 + 206)π'use the following two lines for a special backgroundπ'c = (COS((y * .03515625# - 3.515625) ^ 2) * 63.75 + 63.75)π'c = c + (COS((x * .0265625 - 4.25) ^ 2) * 63.75 + 63.75)πPOKE INT(y) * 320 + INT(x), cπNEXTπNEXTπEND SUBπSUB rgb (gluupin%)           'finds the rgb of a color attributeπSHARED red%, green%, blue%πOUT &H3C7, gluupin%πred% = INP(&H3C9): green% = INP(&H3C9): blue% = INP(&H3C9)πEND SUBπSUB screenmodeπSHARED ca()πDEF SEG = &HA000πSCREEN 13πFOR x = 0 TO 765 STEP 3πx2 = x + 318 * (x > 315)πx3 = x2 + 318 * (x2 > 315)πy = (-(x > 315) - (x > 630)) * 3πLINE (x3, y)-(x3 + 2, y + 2), x / 3, BFπGET (x3, y)-(x3 + 2, y + 2), ca(1, x / 3) 'put colors into array toπNEXT                                      'speed up the fire subπEND subπKurt Kuzba                     BOUNCING GREAT BALLS OF FIRE   FidoNet QUIK_BAS Echo          04-18-96 (00:00)       QB, QBasic, PDS        77   3098     RGB13FLO.BAS'_|_|_|   RGB13FLO.BASπ'_|_|_|   A graphics display program based on a FIDO ECHO messageπ'_|_|_|   From: Mike Castelli   ...   Date: 04-05-96 10:48π'_|_|_|   Subject: Circle Burnπ'_|_|_|   No guarantees or warrantees are given or implied.π'_|_|_|   Released to   PUBLIC DOMAIN   by Kurt Kuzba.  (4/18/96)πCRSX% = CSRLIN: CRSY% = POS(0): ScrPocket 1πTYPE BallsColorDef: R AS INTEGER: G AS INTEGER: B AS INTEGER: END TYPEπTYPE GreatBallsOfFireπ   X AS INTEGER: XD AS INTEGER: Y AS INTEGER: YD AS INTEGERπ   H AS INTEGER: C AS INTEGER: END TYPEπDIM SHARED cr(1 TO 6) AS GreatBallsOfFireπDIM SHARED rgb(1 TO 6, 16) AS BallsColorDefπFOR t% = 0 TO 8π   C% = t% * 5 + 22: B% = (t% + 1) * 2π   rgb(1, t%).R = C%: rgb(1, t%).G = B%: rgb(1, t%).B = t%π   rgb(2, t%).R = t%: rgb(2, t%).G = C%: rgb(2, t%).B = B%π   rgb(3, t%).R = B%: rgb(3, t%).G = t%: rgb(3, t%).B = C%π   rgb(4, t%).R = C%: rgb(4, t%).G = 0: rgb(4, t%).B = C%π   rgb(5, t%).R = 0: rgb(5, t%).G = C%: rgb(5, t%).B = C%π   rgb(6, t%).R = C%: rgb(6, t%).G = C%: rgb(6, t%).B = 0: NEXTπFOR t% = 1 TO 7π   FOR C% = 1 TO 6: rgb(C%, 16 - t%) = rgb(C%, t%): NEXT: NEXTπSCREEN 13: RANDOMIZE (TIMER * 100): PalPocket 1πFOR t% = 1 TO 6π   cr(t%).X = RND * 320: cr(t%).Y = RND * 200π   cr(t%).XD = (RND * 2 + 1): cr(t%).YD = (RND * 2 + 1)π   cr(t%).H = t% * 2: NEXTπWHILE INKEY$ = ""π   CircDrawπ   FOR t% = 1 TO 6π      IF cr(t%).X < 10 THEN cr(t%).XD = ((RND * 999) AND 1) + 1π      IF cr(t%).Y < 10 THEN cr(t%).YD = ((RND * 999) AND 1) + 1π      IF cr(t%).X > 309 THEN cr(t%).XD = -(((RND * 999) AND 1) + 1)π      IF cr(t%).Y > 189 THEN cr(t%).YD = -(((RND * 999) AND 1) + 1)π      cr(t%).X = cr(t%).X + cr(t%).XDπ      cr(t%).Y = cr(t%).Y + cr(t%).YD: NEXTπWEND: PalPocket 0: SCREEN 0: WIDTH 80, 25πLOCATE CRSX%, CRSY%, 1: ScrPocket 0πSUB CircDrawπ   FOR C% = 1 TO 6π      cr(C%).H = (cr(C%).H + 1) AND 15π      cr(C%).C = (cr(C%).C + 14) AND 15π      X% = cr(C%).X: Y% = cr(C%).Y: H% = cr(C%).Hπ      FOR l% = 0 TO 11π         CIRCLE (X%, Y%), l% + 1, ((H% + l%) AND 15) + C% * 16 - 15π      NEXTπ      FOR t% = 1 TO 16π         OUT &H3C8, t% + (C% - 1) * 16: H% = (cr(C%).C + t%) AND 15π         OUT &H3C9, rgb(C%, H%).R: OUT &H3C9, rgb(C%, H%).Gπ         OUT &H3C9, rgb(C%, H%).B: NEXT: NEXTπEND SUBπSUB PalPocket (save%) STATICπ   DIM pal(384) AS INTEGERπ   DEF SEG = VARSEG(pal(0)): O& = VARPTR(pal(0))π   IF save% <> 0 THENπ      FOR t% = 0 TO 255π         OUT &H3C7, t%: POKE O& + t% * 3 + 0, INP(&H3C9)π         POKE O& + t% * 3 + 1, INP(&H3C9)π         POKE O& + t% * 3 + 2, INP(&H3C9): NEXTπ   ELSEπ      FOR t% = 0 TO 255π         OUT &H3C8, t%: OUT &H3C9, PEEK(O& + t% * 3 + 0)π         OUT &H3C9, PEEK(O& + t% * 3 + 1)π         OUT &H3C9, PEEK(O& + t% * 3 + 2): NEXTπ   END IFπEND SUBπSUB ScrPocket (gt%) STATICπ   DIM scr(4000)  AS STRING * 1π   DEF SEG = &HB800π   IF gt% <> 0 THENπ      FOR t& = 0 TO 3999: scr(t&) = CHR$(PEEK(t&) AND 255): NEXTπ   ELSEπ      FOR t& = 0 TO 3999: POKE t&, ASC(scr(t&)): NEXTπ   END IFπEND SUBπ'_|_|_|   end   RGB13FLO.BASπKurt Kuzba                     BUFFERED PCX VIEWER            FidoNet QUIK_BAS Echo          07-20-96 (00:00)       QB, QBasic, PDS        66   2566     PCXVIEW.BAS '>   ok, well the basic gif displayer I have is very slow, aboutπ'>   3-4 min. to display a picture.  Is there a faster way toπ'>   display pixels?π'>..............................................................π'   You might benefit from the use of a buffer. Have a look atπ'this. It is for 320x200x256 .PCX files, but the idea of theπ'screen buffer is implemented. Where a greater ammount ofπ'calculation is required, and multiple bit planes are involved,π'the time savings should be considerable using a buffer.π'With four bit planes, you would use four buffers set up as:π'   DIM buf0(19202) AS INTEGERπ'   DIM buf1(19202) AS INTEGERπ'   DIM buf2(19202) AS INTEGERπ'   DIM buf3(19202) AS INTEGERπ'Once you GET your screen to your buffer, you can write to theπ'buffer your data, and then PUT the data onscreen.ππ'_|_|_|   PCXVIEW.BASπ'_|_|_|   An example of 320x200x256 .PCX display in QBasic.π'_|_|_|   No warrantees or guarantees are given or implied.π'_|_|_|   Released to   PUBLIC DOMAIN   by Kurt Kuzba.  (7/20/96)πON ERROR GOTO OOps: '$DYNAMICπDIM buf(32002) AS INTEGER: buf(0) = 2560: buf(1) = 200π'_|_|_|  init buffer for 2560 bits X 200 linesπBSEG& = VARSEG(buf(2)): BOFS& = VARPTR(buf(2))πINPUT "Name of PCX file to view => ", PCX$: IF PCX$ = "" THEN ENDπbt1! = TIMER: PRINT "Loading file"πOPEN PCX$ FOR INPUT AS #1: CLOSE 1: OPEN PCX$ FOR BINARY AS #1πfin& = LOF(1) - 767: SEEK #1, fin&: pal$ = INPUT$(768, 1)πp% = 1: fin& = fin& - 1: SCREEN 13πFOR T& = 0 TO 255π   OUT &H3C8, T&π   FOR hue% = 1 TO 3π      OUT &H3C9, ASC(MID$(pal$, p%)) \ 4: p% = p% + 1π   NEXTπNEXTπSEEK #1, 129: T& = BOFS&: DEF SEG = BSEG&: CLS : spin% = 1πPRINT "Loading PCX  "; : spinner$ = "//--\\||": rle% = 0πDOπ   PRINT CHR$(29); MID$(spinner$, spin%, 1);π   spin% = (spin% AND 7) + 1π   p$ = INPUT$(256, 1): fpos& = SEEK(1): l% = LEN(p$)π   IF fpos& > fin& THENπ      l% = l% - (fpos& - fin&): p$ = LEFT$(p$, l%): view$ = "done"π   END IFπ   FOR p% = 1 TO l%π      dat% = ASC(MID$(p$, p%))π      IF rle% = 0 THENπ         IF (dat% AND 192) = 192 THENπ            rle% = dat% AND 63π         ELSEπ            POKE T&, dat%: T& = T& + 1π         END IFπ      ELSEπ         FOR rle% = rle% TO 1 STEP -1π            POKE T&, dat%: T& = T& + 1π         NEXTπ      END IFπ   NEXTπLOOP UNTIL view$ = "done"πbt2! = TIMER: CLOSE 1: PUT (0, 0), buf, PSETπWHILE INKEY$ <> "": WEND: WHILE INKEY$ = "": WENDπSCREEN 12: WIDTH 80, 25: PRINT bt2! - bt1!πOOps:π   CLOSE 1: PRINT "error"; ERR: ENDπ'_|_|_|   end   PCXVIEW.BASπDarryl Stokes                  DONUT BALLS                    FidoNet QUIK_BAS Echo          07-22-96 (16:33)       QB, QBasic, PDS        59   1169     DONUTS.BAS  RANDOMIZE TIMERπSCREEN 13ππrecalc:π'CLSππred = 0πgreen = 0πblue = 0ππredbig = INT(RND * 5) + 1πgreenbig = INT(RND * 5) + 1πbluebig = INT(RND * 5) + 1πIF redbig = 2 THEN redbig = .5πIF greenbig = 2 THEN greenbig = .5πIF bluebig = 2 THEN bluebig = .5πIF redbig = 3 THEN redbig = .25πIF greenbig = 3 THEN greenbig = .25πIF bluebig = 3 THEN bluebig = .25πIF redbig = 4 THEN redbig = .75πIF greenbig = 4 THEN greenbig = .75πIF bluebig = 4 THEN bluebig = .75πIF redbig = 5 THEN redbig = 0: red = 1πIF greenbig = 5 THEN greenbig = 0: green = 1πIF bluebig = 5 THEN bluebig = 0: blue = 1ππFOR i = 30 TO 92π red = red + redbigπ blue = blue + bluebigπ green = green + greenbigπ PALETTE i, 65536 * INT(blue) + 256 * INT(green) + INT(red)πNEXT iππc = 32πdir = 1ππcircles:πDOπx = INT(RND * 320) + 1πy = INT(RND * 200) + 1πr = INT(RND * 150) + 1πFOR i = r TO 1 STEP -1πCIRCLE (x, y), i, cπPAINT (x, y), cπSELECT CASE dirπ        CASE 1π        c = c + 1π        IF c = 92 THEN dir = 2π        CASE 2π        c = c - 1π        IF c = 32 THEN dir = 1πEND SELECTπNEXT iπc = 32πdir = 1πIF INKEY$ <> "" THEN ENDπGOTO recalcπLOOPππKurt Kuzba                     PALETTE MANIPULATION           FidoNet QUIK_BAS Echo          06-02-96 (00:00)       QB, QBasic, PDS        86   4033     PALPAL.BAS  '>   'I like this one alot. It uses the PALETTE statementπ'>.......................................................π'   The yin-yang was very nice. Here are some hardware paletteπ'routines you might someday find useful.π'_|_|_|   PALPAL.BASπ'_|_|_|   This is a simple demonstration of methods of paletteπ'_|_|_|   manipulation. Demonstration uses graphics mode 13h.π'_|_|_|   No warrantees or guarantees are given or implied.π'_|_|_|   Released to   PUBLIC DOMAIN   by Kurt Kuzba.  (6/2/96)πDECLARE SUB pal (act$)πSCREEN 13: DEF SEG = &HA000: DIM SHARED red(256) AS INTEGERπDIM SHARED grn(256) AS INTEGER: DIM SHARED blu(256) AS INTEGERπFOR t& = 1 TO 63999: POKE t&, (t& AND 511) \ 2: NEXTπSOUND 999, 3: pal "save"πpal "fadeout": SOUND 999, 3: WHILE INKEY$ = "": WENDπpal "fadein": SOUND 999, 3: WHILE INKEY$ = "": WENDπpal "blackout": SOUND 999, 3: WHILE INKEY$ = "": WENDπpal "restore": SOUND 999, 3: WHILE INKEY$ = "": WENDπSCREEN 0: WIDTH 80, 25: ENDπSUB pal (act$)π   SELECT CASE act$π   ' "save","fadein","fadeout","restore","blackout"π      CASE "save"π         FOR colour% = 0 TO 255π            OUT &H3C7, colour%          ' Set color to readπ            red(colour%) = INP(&H3C9)   ' read red valueπ            grn(colour%) = INP(&H3C9)   ' read green valueπ            blu(colour%) = INP(&H3C9)   ' read blue valueπ         NEXTπ      CASE "fadein"π         DOπ            done% = 0π            FOR colour% = 0 TO 255π               OUT &H3C7, colour%       ' Set color to readπ               red% = INP(&H3C9)        ' read red valueπ               grn% = INP(&H3C9)        ' read green valueπ               blu% = INP(&H3C9)        ' read blue valueπ               ' Test the color values, decrementing if necessary.π               ' Set loop variable if saved palette not in use.π               IF red% < red(colour%) THEN red% = red% + 1: done% = 1π               IF grn% < grn(colour%) THEN grn% = grn% + 1: done% = 1π               IF blu% < blu(colour%) THEN blu% = blu% + 1: done% = 1π               WAIT &H3DA, 8, 8π               OUT &H3C8, colour%       ' Set color to writeπ               OUT &H3C9, red%          ' write red valueπ               OUT &H3C9, grn%          ' write green valueπ               OUT &H3C9, blu%          ' write blue valueπ            NEXTπ         LOOP WHILE done% <> 0π      CASE "fadeout"π         DOπ            visible% = 0π            FOR colour% = 0 TO 255π               OUT &H3C7, colour%       ' Set color to readπ               red% = INP(&H3C9)        ' read red valueπ               grn% = INP(&H3C9)        ' read green valueπ               blu% = INP(&H3C9)        ' read blue valueπ               ' Test the color values, decrementing if necessary.π               ' Set loop variable if colors are still visible.π               IF red% > 0 THEN red% = red% - 1: visible% = 1π               IF grn% > 0 THEN grn% = grn% - 1: visible% = 1π               IF blu% > 0 THEN blu% = blu% - 1: visible% = 1π               WAIT &H3DA, 8, 8π               OUT &H3C8, colour%       ' Set color to writeπ               OUT &H3C9, red%          ' write red valueπ               OUT &H3C9, grn%          ' write green valueπ               OUT &H3C9, blu%          ' write blue valueπ            NEXTπ         LOOP WHILE visible% <> 0π      CASE "restore"π         FOR colour% = 0 TO 255π            OUT &H3C8, colour%          ' Set color to writeπ            OUT &H3C9, red(colour%)     ' write red valueπ            OUT &H3C9, grn(colour%)     ' write green valueπ            OUT &H3C9, blu(colour%)     ' write blue valueπ         NEXTπ      CASE "blackout"π         FOR colour% = 0 TO 255π            OUT &H3C8, colour%          ' Set color to writeπ            OUT &H3C9, 0                ' write red valueπ            OUT &H3C9, 0                ' write green valueπ            OUT &H3C9, 0                ' write blue valueπ         NEXTπ   END SELECTπEND SUBπ'_|_|_|   end   PALPAL.BASπPeter Cooper                   RAY CASTER 3D ENGINE           [e-mail]       08-09-96 (10:31)       QB, QBasic, PDS        93   2705     RAYCAST.BAS ' ==========================================================================π' RAY CASTER 3D sorta ENGINE thingymajigπ' ==========================================================================π' Wrote this about a month ago, it's a sort of wolfenstien\doom lookalikeπ' but all in native QBasic source! Uses an interesting ray tracing techniqueπ' could be optimized x1000  Infact, it's being converted to ASM and stuffπ' like textures will be added and maybe a bit of shadingπ'π' Anyway, this code is _public domain_, change it, modify it, whatever, itπ' only took about 40 mins in total, So whatever.. you have fun with it <grin>π'π' Cheers, {:o)   Peter CooperππDECLARE SUB screensetup ()πDECLARE SUB makeworld ()πDECLARE SUB maketables ()πDIM SHARED st%(0 TO 360)πDIM SHARED ct%(0 TO 360)πDIM SHARED a$(1 TO 10)πpx% = 15: py% = 15: sa% = 0πPRINT "please wait..";πmakeworldπmaketablesπscreensetupπlp1:πFOR t% = sa% TO sa% + 59 STEP 1πxb = st%(t% MOD 360) / 100              'get incπyb = ct%(t% MOD 360) / 100              'get incπbx = px%                                'decimal copyπby = py%                                'decimal copyπl% = 0                                  'reset lengthπDOπbx = bx + xbπby = by + ybπl% = l% + 1πk% = ASC(MID$(a$(CINT(by / 10)), CINT(bx / 10), 1)) - 48πLOOP UNTIL k% <> 0ππ'PRINT l%        this would print the distance to wall from playerπx% = (t% - sa%) * 5πdd% = (1000 / l%)πLINE (x%, 1)-(x% + 5, 99 - dd%), 15, BFπLINE (x%, 101 + dd%)-(x% + 5, 200), 2, BFπLINE (x%, 100 - dd%)-(x% + 5, 100 + dd%), k%, BFπLINE (x%, 100 - dd%)-(x% + 5, 100 - dd%), 0πLINE (x%, 100 + dd%)-(x% + 5, 100 + dd%), 0ππNEXT t%πPCOPY 0, 1ππin$ = INPUT$(1)πIF in$ = "x" THEN sa% = sa% + 3πIF in$ = "z" THEN sa% = (sa% + 357) MOD 360πIF in$ = CHR$(27) THEN SCREEN 0: WIDTH 80, 25: SYSTEMπIF in$ = " " THENπ        px% = px% + (st%(t% MOD 360) / 50)π        py% = py% + (ct%(t% MOD 360) / 50)πEND IFπGOTO lp1:ππSUB maketablesπ' Peters boring _yawn_ table creationπFOR tmp1% = 0 TO 360πst%(tmp1%) = SIN(tmp1% * .0174) * 100πIF tmp1% MOD 100 = 0 THEN PRINT ; ".";πNEXT tmp1%πFOR tmp1% = 0 TO 360πct%(tmp1%) = COS(tmp1% * .0174) * 100πIF tmp1% MOD 100 = 0 THEN PRINT ; ".";πNEXT tmp1%πEND SUBππSUB makeworldπ' Peter Coopers demonstration level. Change it if you wish! Each numberπ'isπ' a color numberπa$(1) = "1919191919"πa$(2) = "9000000001"πa$(3) = "1000000409"πa$(4) = "9010005001"πa$(5) = "1020040009"πa$(6) = "9030000001"πa$(7) = "1000078009"πa$(8) = "9050087001"πa$(9) = "1060000009"πa$(10) = "9191919191"πEND SUBππSUB screensetupπSCREEN 8, , 0, 1πCLSπWINDOW SCREEN (1, 1)-(320, 200)πEND SUBπJonathan Leger                 LED SCREEN SAVER               [e-mail]             08-12-96 (21:02)       QB, QBasic, PDS        274  8803     LED.BAS     DEFINT A-Zππ'LedDisplay() routine Original Author: Scott Pessoni - August 1995π'---> Modified by Jonathan Leger <---ππ'All other code, including InitLedDisplay() and InitLedBar(), writtenπ'by Jonathan Leger ([e-mail]).ππDECLARE SUB InitLedDisplay (x%, y%, onc%, offc%, digits%, v%, a%)πDECLARE SUB InitLedBar (x%, y%, onc%, offc%, elems%, maxval%, v%, a%)πDECLARE SUB LedBar (Number#)πDECLARE SUB LedDisplay (Number#)ππDIM SHARED DisplayLedX, DisplayLedY, LedDigits, OnColor, OffColor, apage, vpageπDIM SHARED GraphLedX, GraphLedY, GraphElements, GraphNumππ'This string, scrollmsg$, _must_ have a space at the end.πscrollmsg$ = "REAL PROGRAMERS USE BASIC... ": scrollclr = 14ππSCREEN 7ππt# = TIMERπx# = 0πDOπ  x# = x# + 1πLOOP UNTIL TIMER - t# > 1ππx# = x# / 5ππRANDOMIZE TIMERπcx = INT(RND * 280): cy = INT(RND * 160) + 12πxd = INT(RND * 2) + 1πIF xd = 1 THENπ   xdir = -1πELSEπ   xdir = 1πEND IFπyd = INT(RND * 2) + 1πIF yd = 1 THENπ   ydir = -1πELSEπ   ydir = 1πEND IFππdigits = 1: fore = 9: back = 8πsloc = 40: slet = 1: stog = 0ππDOππFOR Count# = VAL(STRING$(digits - 1, "9")) TO VAL(STRING$(digits, "9"))ππ   x2# = 0π   DOπ      x2# = x2# + 1π   LOOP UNTIL x2# >= x#ππ   stog = stog + 1π   IF stog = 5 THENπ      stog = 0π      SCREEN , , apage, vpageπ      LOCATE 1, 1: PRINT STRING$(40, " ");π      IF fore = 15 THENπ         COLOR 9π      ELSEπ         COLOR fore + 1π      END IFπ      LOCATE 1, slocπ      PRINT MID$(scrollmsg$, slet, (40 - sloc));π      sloc = sloc - 1π      IF sloc = 0 THENπ         sloc = 1π         slet = slet + 1π         FOR sc = 2 TO 25π            IF slet - sc < 1 THEN EXIT FORπ            LOCATE sc, 1: PRINT MID$(scrollmsg$, slet - sc, 1);π         NEXT scπ         IF sc = 26 AND slet - sc = LEN(scrollmsg$) THENπ            slet = 1: sloc = 40π         END IFπ      END IFπ   END IFππ   InitLedDisplay cx, cy, 0, 0, digits, 0, 1π   LedDisplay -1ππ   cx = cx - xdirπ   cy = cy - ydirππ   IF cx < 12 THENπ      xdir = xdir * -1π      cx = 12π   ELSEIF cy < 12 THENπ      ydir = ydir * -1π      cy = 12π   ELSEIF cx > 280 THENπ      xdir = xdir * -1π      cx = 280π   ELSEIF cy > 180 THENπ      ydir = ydir * -1π      cy = 180π   END IFππ   InitLedDisplay cx, cy, fore, back, digits, 0, 1ππ   LedDisplay Count#ππ   key$ = INKEY$ππ   SELECT CASE key$π         CASE CHR$(27)π            EXIT DOπ   END SELECTππ   IF (Count# MOD 100) = 0 THENπ      fore = fore + 1π      IF fore > 15 THEN fore = 9π   END IFππNEXT Count#ππdigits = digits + 1ππLOOPππSUB InitLedBar (x%, y%, onc%, offc%, elems%, maxval%, v%, a%)ππapage% = a%: vpage% = v%πSCREEN , , apage%, vpage%ππGraphLedX = x%  '|- Upper Left corner ofπGraphLedY = y% '|  Led Graph displayπGraphElements = elems%  'Number of graph elements. Maximum 32πGraphNum = maxval% 'The number when the graph is 100%ππEND SUBππSUB InitLedDisplay (x, y, onc, offc, digits, v, a)ππapage = a: vpage = vππSCREEN , , apage, vpageππDisplayLedX = x '|- Upper Left corner ofπDisplayLedY = y '|  Led Digit displayπLedDigits = digits   'Number of digits to have on displayππOnColor = onc: OffColor = offcππLedDisplay -1ππEND SUBππ'LedBar: A simulated Led Bargraphπ'-----------------------------------------------π'LedBar Numberπ'    Number = The current number you want to update the bar graph withπ'-----------------------------------------------πSUB LedBar (Number#)ππIF Number# < 0 THEN 'If Negitive then blank Bar Graphπ     FOR MakeGraph = 1 TO GraphElements * 2 STEP 2 'Make the Bar graphπ          LINE (GraphLedX + MakeGraph, GraphLedY)-(GraphLedX + MakeGraph, GraphLedY + 5), OffColor%π     NEXT MakeGraphπ     EXIT SUBπEND IFππElements = INT(Number# * GraphElements / GraphNum) 'Calculate Number ElementsπIF Elements > GraphElements THEN Elements = GraphElements 'Check limtsππ'----------------- Draw Bar Graph --------------------------------πFOR MakeGraph = 1 TO Elements * 2 STEP 2 'Make the Bar graph (Lit)πLINE (GraphLedX + MakeGraph, GraphLedY)-(GraphLedX + MakeGraph, GraphLedY + 5), OnColor%πNEXT MakeGraphπFOR MakeGraph = Elements * 2 + 1 TO GraphElements * 2 STEP 2 'Make the Bar graph (DimπLINE (GraphLedX + MakeGraph, GraphLedY)-(GraphLedX + MakeGraph, GraphLedY + 5), OffColor%πNEXT MakeGraphπ'------------------------------------------------------------------πEND SUBππ'LedDisplay: Generates a simulated Digital Led Display.π'------------------------------------------------------------π'LedDisplay (Number)π'    Number = The number you want to display on the Digital Displayπ'------------------------------------------------------------πSUB LedDisplay (Number#)ππSCREEN , , apage, vpageππIF Number# < 0 THEN  'Setup Led Display panelπ     FOR PlotX = DisplayLedX TO DisplayLedX + ((LedDigits - 1) * 8) STEP 8π          '----------- One LED Matrix digit --------------------π          LINE (PlotX + 1, DisplayLedY)-(PlotX + 5, DisplayLedY), OffColor%π          LINE (PlotX, DisplayLedY + 1)-(PlotX, DisplayLedY + 5), OffColor%π          LINE (PlotX + 6, DisplayLedY + 1)-(PlotX + 6, DisplayLedY + 5), OffColor%π          LINE (PlotX + 1, DisplayLedY + 6)-(PlotX + 5, DisplayLedY + 6), OffColor%π          LINE (PlotX, DisplayLedY + 7)-(PlotX, DisplayLedY + 11), OffColor%π          LINE (PlotX + 6, DisplayLedY + 7)-(PlotX + 6, DisplayLedY + 11), OffColor%π          LINE (PlotX + 1, DisplayLedY + 12)-(PlotX + 5, DisplayLedY + 12), OffColor%π          '------------------------------------------------------π     NEXT PlotXπ     EXIT SUBπEND IFππNumber# = FIX(Number#) 'Get rid of the decimals incase there are someπNumber# = VAL(LEFT$(STR$(Number#), LedDigits + 1)) 'Chop Number to LED sizeππPlotX = DisplayLedXππIF LEN(STR$(Number#)) - 1 < LedDigits THEN  'Clear Unused digitsπ     FOR ClearEmptyDigits = 1 TO LedDigits - (LEN(STR$(Number#)) - 1)π     LINE (PlotX + 1, DisplayLedY)-(PlotX + 5, DisplayLedY), OffColor%π     LINE (PlotX, DisplayLedY + 1)-(PlotX, DisplayLedY + 5), OffColor%π     LINE (PlotX + 6, DisplayLedY + 1)-(PlotX + 6, DisplayLedY + 5), OffColor%π     LINE (PlotX + 1, DisplayLedY + 6)-(PlotX + 5, DisplayLedY + 6), OffColor%π     LINE (PlotX, DisplayLedY + 7)-(PlotX, DisplayLedY + 11), OffColor%π     LINE (PlotX + 6, DisplayLedY + 7)-(PlotX + 6, DisplayLedY + 11), OffColor%π     LINE (PlotX + 1, DisplayLedY + 12)-(PlotX + 5, DisplayLedY + 12), OffColor%π     PlotX = PlotX + 8π     NEXT ClearEmptyDigitsπEND IFπππFOR PlotDigit = 1 TO LEN(STR$(Number#)) - 1 'Plot each number to a LEDππWorkDigit$ = MID$(STR$(Number#), PlotDigit + 1, 1) 'Get 1 DigitππSELECT CASE WorkDigit$ 'Find and select which elements to turn onπ     CASE "0"π          E1 = OnColor%: E2 = OnColor%: E3 = OnColor%: E4 = OffColor%: E5 = OnColor%: E6 = OnColor%: E7 = OnColor%π   π     CASE "1"π          E1 = OffColor%: E2 = OffColor%: E3 = OnColor%: E4 = OffColor%: E5 = OffColor%: E6 = OffColor%: E7 = OnColor%π  π     CASE "2"π          E1 = OffColor%: E2 = OnColor%: E3 = OnColor%: E4 = OnColor%: E5 = OnColor%: E6 = OnColor%: E7 = OffColor%π  π     CASE "3"π          E1 = OffColor%: E2 = OnColor%: E3 = OnColor%: E4 = OnColor%: E5 = OffColor%: E6 = OnColor%: E7 = OnColor%π  π     CASE "4"π          E1 = OnColor%: E2 = OffColor%: E3 = OnColor%: E4 = OnColor%: E5 = OffColor%: E6 = OffColor%: E7 = OnColor%π π     CASE "5"π          E1 = OnColor%: E2 = OnColor%: E3 = OffColor%: E4 = OnColor%: E5 = OffColor%: E6 = OnColor%: E7 = OnColor%π  π     CASE "6"π          E1 = OnColor%: E2 = OffColor%: E3 = OffColor%: E4 = OnColor%: E5 = OnColor%: E6 = OnColor%: E7 = OnColor%π  π     CASE "7"π          E1 = OffColor%: E2 = OnColor%: E3 = OnColor%: E4 = OffColor%: E5 = OffColor%: E6 = OffColor%: E7 = OnColor%π  π     CASE "8"π          E1 = OnColor%: E2 = OnColor%: E3 = OnColor%: E4 = OnColor%: E5 = OnColor%: E6 = OnColor%: E7 = OnColor%π  π     CASE "9"π          E1 = OnColor%: E2 = OnColor%: E3 = OnColor%: E4 = OnColor%: E5 = OffColor%: E6 = OffColor%: E7 = OnColor%πEND SELECTπ'Plot the LEDs to the screen------------------------πLINE (PlotX, DisplayLedY + 1)-(PlotX, DisplayLedY + 5), E1πLINE (PlotX + 1, DisplayLedY)-(PlotX + 5, DisplayLedY), E2πLINE (PlotX + 6, DisplayLedY + 1)-(PlotX + 6, DisplayLedY + 5), E3πLINE (PlotX + 1, DisplayLedY + 6)-(PlotX + 5, DisplayLedY + 6), E4πLINE (PlotX, DisplayLedY + 7)-(PlotX, DisplayLedY + 11), E5πLINE (PlotX + 1, DisplayLedY + 12)-(PlotX + 5, DisplayLedY + 12), E6πLINE (PlotX + 6, DisplayLedY + 7)-(PlotX + 6, DisplayLedY + 11), E7π'--------------------------------------------------πPlotX = PlotX + 8πNEXT PlotDigitππPCOPY apage, vpageππSCREEN , , vpage, vpageππEND SUBπClaude Gagné                   ICON MAKER V1.0                [e-mail]       08-16-96 (09:25)       QB, QBasic, PDS        486  11658    ICONMAKE.BAS'****************************************************************************π'*                     [ Icon maker  Version 1.0 ]                          *π'*                   [ Claude Gagné, Toronto, 1996 ]                        *π'*            [ You can Email me at: [e-mail] ]             *π'*                                                                          *π'*     [ You can modify this program but please, give me some credits !]    *π'*                                                                          *π'*                [ This program make 50 X 50 pixels icons ]                *π'*            [ You can load those icon by using BLOAD command ]            *π'*                                                                          *π'*                 The mouse routines have been taken from                  *π'*                        Le Grand livre du QBASIC                          *π'*                         (c) Micro Application                            *π'*                                  1992                                    *π'****************************************************************************ππDECLARE SUB fenetre (xup%, yup%, xdown%, ydown%, aspect%, couleur%)πDEFINT A-ZππDECLARE SUB initsouris ()πDECLARE SUB souris (OnOff%)πDECLARE SUB FormeSouris (SoftHard%, BMasque%, CMasque%)πDECLARE SUB SetSouris (X%, Y%)πDECLARE SUB TempoSouris (Tempo%)πDECLARE SUB zonexsouris (X1%, x2%)πDECLARE SUB zoneysouris (Y1%, Y2%)πDECLARE SUB getsouris (Mode%)πDECLARE SUB attendrelachebouton ()πDECLARE SUB attenddeplacement (Mode%)πππDECLARE SUB ReadData ()πDECLARE FUNCTION Interr% (Num%, ax%, bx%, cx%, dx%)ππDECLARE SUB ABSOLUTE (Fonction%, par1%, par2%, par3%, adr%)ππππ'**********  définir les variables globales  **********ππDIM SHARED sourisx%, sourisy%, sourisk%       '*** position et bouton de la sourisππDIM SHARED PM%(45)                      '** tableau pour le programme machineπReadData                                '** lire le programme machineππππππSCREEN 12πinitsourisπCLSππON ERROR GOTO gestionππDIM tampon(1 TO 1432)ππCALL fenetre(0, 0, 639, 479, 1, 7)πCALL fenetre(10, 10, 270, 270, 0, 0)πCALL fenetre(280, 10, 340, 70, 0, 0)ππCALL fenetre(286, 16, 335, 65, 1, 7)πGOSUB miseajourππCALL fenetre(280, 235, 629, 270, 0, 0)   ' FENETRE COULEURππFOR c = 1 TO 16πLINE (c * 20 + 280, 240)-(c * 20 + 300, 265), c - 1, BFπNEXT cππCALL fenetre(280, 80, 340, 140, 0, couleur1)  ' fenetre couleur1πCALL fenetre(280, 150, 340, 210, 0, couleur2) ' fenetre couleur2ππCALL fenetre(350, 10, 629, 225, 0, 0)    ' FENETRE FONCTIONSππCALL fenetre(10, 280, 629, 469, 0, 0)    ' FENETRE TEXTEππLOCATE 2, 46: COLOR 14: PRINT "Functions List"πCOLOR 15πLOCATE 3, 46: PRINT "F1 - New Icon"πLOCATE 4, 46: PRINT "F2 - Save"πLOCATE 5, 46: PRINT "F3 - Load"πCOLOR 7πLOCATE 6, 46: PRINT "F4 - Not Avail."πCOLOR 15πLOCATE 7, 46: PRINT "F5 - Shadow (Up)"πLOCATE 8, 46: PRINT "F6 - Shadow (Down)"πLOCATE 9, 46: PRINT "F7 - Shadow (Left)"πLOCATE 10, 46: PRINT "F8 - Shadow (right)"πLOCATE 11, 46: PRINT "F9 - Erase/Fill"πCOLOR 7πLOCATE 12, 46: PRINT "F10 - Not avail."πCOLOR 15πLOCATE 13, 46: PRINT "ESC => exit"πππsouris 1πDOπgetsouris 0πclavier$ = UCASE$(INKEY$)ππIF clavier$ = CHR$(0) + CHR$(59) THENππCALL fenetre(286, 16, 335, 65, 1, couleur1)πGOSUB miseajourπEND IFπππIF clavier$ = CHR$(0) + CHR$(60) THEN GOSUB sauvegardeπIF clavier$ = CHR$(0) + CHR$(61) THEN GOSUB chargementπIF clavier$ = CHR$(0) + CHR$(62) THEN GOSUB changercouleurπIF clavier$ = CHR$(0) + CHR$(63) THEN GOSUB ombrerhautπIF clavier$ = CHR$(0) + CHR$(64) THEN GOSUB ombrerbasπIF clavier$ = CHR$(0) + CHR$(65) THEN GOSUB ombrergaucheπIF clavier$ = CHR$(0) + CHR$(66) THEN GOSUB ombrerdroiteπIF clavier$ = CHR$(0) + CHR$(67) THEN GOSUB remplissageπIF sourisk% = 1 THENπIF sourisx% > 285 AND sourisy% > 235 AND sourisx% < 624 AND sourisy% < 265 THENπsouris 0πcouleur1 = POINT(sourisx%, sourisy%)πCALL fenetre(280, 80, 340, 140, 0, couleur1)πsouris 1πEND IFππIF sourisy% AND sourisx% > 285 AND sourisy% > 235 AND sourisx% < 624 AND sourisy% < 265 THENπsouris 0πcouleur2 = POINT(sourisx%, sourisy%)πCALL fenetre(280, 150, 340, 210, 0, couleur2)πsouris 1πEND IFππFOR X = 1 TO 50πFOR Y = 1 TO 50ππIF sourisx% > X * 5 + 10 AND sourisy% > Y * 5 + 10 AND sourisx% < X * 5 + 15 AND sourisy% < Y * 5 + 15 THENπsouris 0πLINE (X * 5 + 11, Y * 5 + 11)-(X * 5 + 14, Y * 5 + 14), couleur1, BFπPSET (285 + X, 15 + Y), couleur1πsouris 1πEXIT FORπEXIT FORπEND IFππIF sourisy% AND sourisx% > X * 5 + 10 AND sourisy% > Y * 5 + 10 AND sourisx% < X * 5 + 15 AND sourisy% < Y * 5 + 15 THENπsouris 0πLINE (X * 5 + 11, Y * 5 + 11)-(X * 5 + 14, Y * 5 + 14), couleur2, BFπPSET (285 + X, 15 + Y), couleur2πsouris 1πEXIT FORπEXIT FORπEND IFππNEXT YπNEXT XπEND IFπLOOP WHILE clavier$ <> CHR$(27)πsouris 0πCLSπENDππmiseajour:πsouris 0πFOR X = 1 TO 50πFOR Y = 1 TO 50πLINE (X * 5 + 11, Y * 5 + 11)-(X * 5 + 14, Y * 5 + 14), POINT(285 + X, 15 + Y), BFπNEXT YπNEXT Xπsouris 1πRETURNππombrerhaut:πsouris 0ππFOR X = 1 TO 50πFOR Y = 1 TO 50ππIF POINT(285 + X, 15 + Y) = couleur1 AND POINT(285 + X, 14 + Y) <> couleur1 THENπPSET (285 + X, 14 + Y), couleur2πEND IFππNEXT YπNEXT XππGOSUB miseajourπsouris 1πRETURNππombrerbas:πsouris 0ππFOR X = 1 TO 50πFOR Y = 1 TO 50ππIF POINT(285 + X, 15 + Y) = couleur1 AND POINT(285 + X, Y + 16) <> couleur1 THENπPSET (285 + X, 16 + Y), couleur2πEND IFππNEXT YπNEXT XππGOSUB miseajourπsouris 1πRETURNππombrergauche:πsouris 0ππFOR X = 1 TO 50πFOR Y = 1 TO 50ππIF POINT(285 + X, 15 + Y) = couleur1 AND POINT(284 + X, 15 + Y) <> couleur1 THENπPSET (284 + X, 15 + Y), couleur2πEND IFππNEXT YπNEXT XππGOSUB miseajourπsouris 1πRETURNππombrerdroite:πsouris 0ππFOR X = 1 TO 50πFOR Y = 1 TO 50ππIF POINT(285 + X, 15 + Y) = couleur1 AND POINT(286 + X, 15 + Y) <> couleur1 THENπPSET (286 + X, 15 + Y), couleur2πEND IFππNEXT YπNEXT XππGOSUB miseajourπsouris 1πRETURNππchangercouleur:πsouris 0ππFOR X = 1 TO 50πFOR Y = 1 TO 50ππIF POINT(285 + X, 15 + Y) = couleur1 THENπPSET (285 + X, 15 + Y), couleur2πEND IFππNEXT YπNEXT XππGOSUB miseajourπsouris 1πRETURNππsauvegarde:πsouris 0πLOCATE 20, 5: PRINT STRING$(65, 255);πLOCATE 20, 5: LINE INPUT "Sauvegarde [.ICO]: "; fichier$πIF LEN(fichier$) = 0 THEN GOTO finsauvegardeππGET (286, 16)-(335, 65), tamponππDEF SEG = VARSEG(tampon(1))πBSAVE fichier$ + ".ICO", VARPTR(tampon(1)), 1432πDEF SEGπBEEPππfinsauvegarde:πLOCATE 20, 5: PRINT STRING$(65, 255);πsouris 1πRETURNππchargement:πsouris 0πLOCATE 20, 5: PRINT STRING$(65, 255);πLOCATE 20, 5: LINE INPUT "Chargement [.ICO]: "; fichier$πIF LEN(fichier$) = 0 THEN GOTO finchargementππDEF SEG = VARSEG(tampon(1))πBLOAD fichier$ + ".ICO", VARPTR(tampon(1))πDEF SEGππPUT (286, 16), tampon, PSETππGOSUB miseajourππBEEPππfinchargement:πLOCATE 20, 5: PRINT STRING$(65, 255);πsouris 1πRETURNπππremplissage:ππsouris 0ππFOR X = 1 TO 50πFOR Y = 1 TO 50ππPSET (285 + X, 15 + Y), couleur1ππNEXT YπNEXT XππGOSUB miseajourπsouris 1πRETURNππgestion:πBEEPπBEEPπRESUME NEXTπππMS.Data:        '***** DATA du programme machine pour Interr%()π DATA 55,8b,ec,56,57            'sauver le registreπ DATA 8b,76,0c,8b,04            'chercher AX à DXπ DATA 8b,76,0a,8b,1cπ DATA 8b,76,08,8b,0cπ DATA 8b,76,06,8b,14π DATA cd,21                     'INT 21 (numéro modifié !)π DATA 8b,76,0c,89,04            'réécrire AX à DXπ DATA 8b,76,0a,89,1cπ DATA 8b,76,08,89,0cπ DATA 8b,76,06,89,14π DATA 5f,5e,5d                  'chercher le registreπ DATA ca,08,00                  'RETF 8  =>  finπ DATA #πππSUB attenddeplacement (Mode%)π'** Attendre le déplacement de la souris ou l'appui/relâchement du boutonππ getsouris Mode%π X% = sourisx%: Y% = sourisy%: K% = sourisk%ππ DOπ  getsouris Mode%π LOOP UNTIL X% <> sourisx% OR Y% <> sourisy% OR K% <> sourisk%ππEND SUBππSUB attendrelacheboutonπ'** Attendre le relâchement du bouton de la sourisππ WHILE sourisk%π  getsouris 0π WENDππEND SUBππSUB fenetre (xup, yup, xdown, ydown, aspect, couleur)πππIF aspect <= 0 THENπ        surface = 8π        ombre = 15π        lumiere = 8πEND IFππIF aspect >= 1 THENπ        surface = 7π        ombre = 8π        lumiere = 15πEND IFππLINE (xup, yup)-(xdown, ydown), surface, BFππLINE (xup, yup)-(xdown, ydown), ombre, BπLINE (xup + 1, yup + 1)-(xdown - 1, ydown - 1), ombre, BππLINE (xup, yup)-(xup, ydown), lumiereπLINE (xup + 1, yup + 1)-(xup + 1, ydown - 1), lumiereππLINE (xup, yup)-(xdown, yup), lumiereπLINE (xup + 1, yup + 1)-(xdown - 1, yup + 1), lumiereππLINE (xup + 3, yup + 3)-(xdown - 3, ydown - 3), couleur, BFππππEND SUBππSUB FormeSouris (SoftHard%, BMasque%, CMasque%)π'** Définir l'apparition du curseur de la sourisππ R% = Interr%(&H33, 10, SoftHard%, BMasque%, CMasque%)      '** définir FormeSourisππEND SUBππSUB getsouris (Mode%)π'** Chercher dans SourisX%, SourisY% et SourisK% la position de la souris et l'état du boutonππ  R% = Interr%(&H33, 3, bx%, cx%, dx%)ππ  sourisk% = bx%                  '** bouton (1=gauche, 2=droit)π π  IF Mode% THENπ   sourisx% = cx% / 16 + 1         '** position X (mode texte)π   sourisy% = dx% / 16 + 1          '** position Y (mode texte)π  ELSEπ   sourisx% = cx%                  '** position X (mode graphique)π   sourisy% = dx%                  '** position Y (mode graphique)π  END IFππEND SUBππSUB initsourisπ'** Initialiser le gestionnaire de la sourisππ R% = Interr%(&H33, 0, bx%, cx%, dx%)   '** initialiser le gestionnaire de la sourisππEND SUBππFUNCTION Interr% (Num%, ax%, bx%, cx%, dx%)π'** Réaliser l'interruption numéro Num% avec les contenus des registres de AX% à DX%ππ IF PM%(0) = 0 THEN                     '** PM%() est initialisé ?π  PRINT "ERREUR : programme machine absent ! Arrêt!"π  ENDπ END IFππ DEF SEG = VARSEG(PM%(0))               '** définir le segmentπ POKE VARPTR(PM%(0)) + 26, Num%         '** mettre en oeuvre le numéro de l'interruptionππ CALL ABSOLUTE(ax%, bx%, cx%, dx%, VARPTR(PM%(0))) '** appelππ Interr% = ax%                          '** valeur retournée prise dans AX%ππEND FUNCTIONππSUB ReadDataπ'** Lire les DATA pour le programme machine dans PM%()ππ RESTORE MS.Dataπ DEF SEG = VARSEG(PM%(0))ππ FOR i% = 0 TO 99π  READ Octet$π  IF Octet$ = "#" THEN EXIT FORπ  POKE VARPTR(PM%(0)) + i%, VAL("&H" + Octet$)π NEXT i%ππEND SUBππSUB SetSouris (X%, Y%)π'** Définir la position du pointeur de la sourisπ'** X% et Y% sont en coordonnées caractères en mode texteππ R% = Interr%(&H33, 4, bx%, X% * 16 - 16, Y% * 16 - 16)ππEND SUBππSUB souris (OnOff%)π'** Allumer / Eteindre le pointeur de la souris (0=éteint, 1=allumé)ππ IF OnOff% = 0 THEN OnOff% = 2 ELSE OnOff% = 1π R% = Interr%(&H33, OnOff%, bx%, cx%, dx%)ππEND SUBππSUB TempoSouris (Speed%)π'** Définir la vitesse de la souris (0=rapide, 100=très lente)ππ R% = Interr%(&H33, 15, bx%, Speed%, Speed% * 2)ππEND SUBππSUB zonexsouris (X1%, x2%)π'** Définir la zone de déplacement horizontal de la souris de X1% à X2%π'** X1% et X2% sont des coordonnées caractères en mode texteππ R% = Interr%(&H33, 7, 0, X1% * 16 - 16, x2% * 16 - 16)ππEND SUBππSUB zoneysouris (Y1%, Y2%)π'** Définir la zone de déplacement vertical de la souris de Y1% à Y2%π'** Y1% et Y2% sont des coordonnées caractères en mode texteππ R% = Interr%(&H33, 8, bx%, Y1% * 16 - 16, Y2% * 16 - 16)ππEND SUBπGerald Filimonov               ANIMATION FACTORY V1.0         [e-mail]           03-26-95 (12:50)       QB, QBasic, PDS        137 8847     ANIFACT.BAS 'Animation Factory 1.0, Copyright, 1995, All Rights Reservedππ'    This program was created using Qbasic, a programming language that comesπ'with most DOS packages.ππ'    This program will allow you to edit a series of frames and play them π'back in a certain order. You may choose between four colors and a couple of  π'editing techniques, such as Cut,Copy,Paste,DrawLine, etc.ππDEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"ANIFACT.ZIP",4^6:Z&=6074:?STRING$(50,177);πU"%up()%9%%%I-%:0/ICzA;:oK3R%%(=%%%1%%%%fs%nrfy%jWSg7fxfB):B?^lk4πU"zuIDyczR3']5a+lo5?7;o5?,:9&ZW9OLd]OmF1w:R4n?'pdJ>I\52s%:5X3o'BPπU"ENUHE-)RDc0MTFY-qF%\6m?>&.44SQulErrhb:n[>>q7p+RbeWD<I+Fqg'arFxhπU"Hu$0l>WnLqk27NNhmeT_X&5-U%ZfVG&l6rC/0S3IZ]x?=s]#f#,;jEi#$=;'f=tπU"8u3\/6u</wqo=C.5u\%))9>&$.9>/$.C]Id45z//&p&5w8gQb2jm#9S.OP((sK(πU"YZYdCuw)=9pr'6&.)M'&m]%vrZZgWa)%yJ1nC5u$LFgLenj%I?D;I\(e0]D%W:<πU"iHmZ-7U(*iKe$VIeRq^zZv'?)0L,:+Yu;yPw_PnX(1$6'q7*.vX9RV'Sk-WW+\kπU"6lDsX1iB1PZ?AZN5EQ></b>=X$6.pf.bnUh'Q-XfXq%:-YlG-E-4h2reA'b2nP*πU"4>zdRr6)9i%0I4PZgMlPOcV]pIJjTvz*b+K=qA:3538l;u/l&o1l\R3o(l:;GblπU"UsxL$X#VYo$Vz2z=V17Shq0YAw)'a),:Tmd/5b+MsB<U-n?$01-nIUhr4dnYPgQπU"cF_/BnllhGV>vp6?lB[ke>;$9DU%E:]0e[Z_N:Tu42x:QKh0$12VR7QC;b2QLg/πU"6lqMiW%VMf33m4TbKMKG?GH9#mMRGJh,IYuEB/G5\[r5BDnqF1EZG<6CE%MvnF[πU"34gCuq>Y5HhtBIs:KK35QMeB.LL-nlL$d\YvB]cZV\ix%Gg'mVi,(+kxPBS.0TMπU"6A\w<Q+50dID(vek;+$xm%8:3*Xo]ZP]%u9lXjpiOXoV#rt?m&G1lNKIFb1c>j1πU"ureE#rANs]iTwWr_Iv.F%Nk6xQRqCcba0=t2>(*:Y==HV:F/IB%yuU+S'pKI5y9πU"9;nf'C-+fO?J7D-&oU.EBeV'Z_D-gY\3$,;/J+G-W$ij1&35%C^#k5).(%2x7('πU"oEXkRIO]9d(YQQMOO]8'e3'Fg=D99I_=)S;(m$*4f1^&O841ES:%Z1A/PD/,1l8πU";R:+'xi?m[s-)x>sja#a)r-.Tlf\C.DW_?dd57%>8rv+*;k&=i>WP9%<-UZb]qxπU"88B6&sSV,f=90lP[iBWs0=9%NIBJgtU_fML:3a^)hc3XKQe)rMFQw^fYTV5&W'sπU"7pDU4R4Ju)#A0C75G%t/sPe0on;=RXG4[TWGV]GcRy#ARbooEAP>b9%3n2*fFI_πU"B5-goVFs\^hU3s;k84Ska'g;[u(N]h+Xr1.=$[PjNbI_+Vn.o^*+-Z,oQ8D0\0(πU"w_O+V[c)XoH1=$\8jpwAE)aFjAeAS]+q+UMN=Y4Z;8JV$shco5Bf,v=R$$4_t:EπU"82)Q)Z59eVOp7sb[XM=4Os'hBJ&u<\f:t$p&+RJPHvXc;ll_Z8<wT(]X3.fqBF_πU"A(P3?aiLJD8fZ094bJW=sB=P:Wrt]ms%Y/[=AUdD]H+#sPni/2<F(O2,XlrszC?πU"FAl*etI0OH8\&E3%xL)pzDejxKfgVEz\b?%$3*gwFB>?%$Nh$Sl_.\a:tb7qYYhπU"bCD*[Fz>=4guKKMcEUc-N587v)sccY'$t??uV*>AJc5Z#:$3w-GFsgql1Pvs%IeπU"$6\.TAi]SHj+\EV5_*rTE#4/+#*nH_n5[4ct;%<Q7\<oMbr:mrZzUNs3cKSa>=kπU"m#j$QF6R&iTjz6VR&TXDV2TxE(EJMYJlMx;bi$RhIV2#qi:K)\I/f_4ic/sqqF9πU"t8N'j,%hz\mY]\LKKj,5V+KDR2(SST8i9N$+ebQ(mtDp0X8e&f$.0u3h]A\IDmuπU"uo$-Q8mh-b_2NZ4#Km.E#E9^q)0bpH/wo$'VIdGI.'xZM]Yc8jr3-bnp+7--RViπU"\mBGHSS-gq%=(YT%k;aCSFZCl:nqij0VQ+MjzU,S7XZTM:&CAcB0Y^g2#$8Q4'+πU"hd>_^<GTq,B]ZxWB4_Cvno4b1>GrRl*hFVGE5m?W]Q*\6h<nqvE3Wn?i=p.70q1πU"hU>UCjdrkfRzuZY>.&_XsR+4b'Op_1jb==RWOI$=VuA$4:WrhZ6#\ICW%k\V*/DπU"D-^1eOW#y+]]qWE*4P6T,,)ASOaGkw%;7&xBI:ln4<q5:\<;&7m:;jvPLK0W7mgπU"<<ajd0iZZ\:)nTF]'&I_S&y3.Iu5$;jAZSwxobgl,044F56M_?^%pN[h>&+XJ:gπU"H.vsejGF$L(yf^?4gT>3M^'RQ9MYRfi76+hInK;PMGAgb^)nvfCInS*/<?9EgLvπU"K]/=nqP]eHA:CT\[vX_Jcw1BLNgS+?Vo;fv=:Sm#iNl<0$mk7g<37&6Fk9.eU_-πU")c>3.[(h9JpKENF>g.7(_e)k=HsvKa>qDQZ%m<Z<%sgs[s=*fP=\Q3g?l%,uNoXπU"/-GUqf.]^5)&-/'TLfovEp1y8h>xO_kPX9j&&o]VJO>*$rjMk(JbTef?KhO4o82πU".;o+rS-*E5z$bP%\ExhR(X^b5mSlacCU7LLh#K+\__l+*?UBh#q0D;c[[N.>n0&πU"5$hZS$]Gfu+3'_wFO)S(eaVK^2'nbDJfR8[%nWp$.Ull=nX^S=b[E8<Z1\:ha>ZπU"Xl5N?k<8oSH^gBL$u]x0pa0lRxn5mR1gEUAB9Fu63u,u]&rI74m>[qneNb9<y>/πU",wMrHU#k#M69-QK[cM-/#lvgssE8)ORlV0)[hZTYE#u#5H<y?Sm]/sg_VXp8><AπU"n8^qZC%1P#6Uj9[PJ-q%#2'Pi&-9L%1mFUtiAfV]s&a%o9D+d/B[>DGlAI^DWU2πU"s173b83h7=t3:Qk%X+Y+e-:/wNtq[)p>?=wZ97L;+;3g*KyY)QH_a=^wvW??xafπU"Cl4uAY<HN30FlK$TrAIK+8X_n76pu=;i[jK;f/XnL[[bnr)MN21oeE1PI5*wAkJπU"v/5#*kQhRhg#alE2c(,Y76&)N&]D$^t4iaTZt3MLs7+g9>O7F7Ne./+mr6pNBHZπU"K-5wqhGuij6RbmmhtCA/h<pM(%6wzi3zORDT2,\).KRA2*oX;,v3py=;[jYma7>πU"qOMN1&q(?)m:I5QV#9pg,)uFY4%eR2whsub:<5Rr=*&evW7gwC4NjA8xQamSb/1πU"sW%I8N;bahdk.YqAgDE$QzTj:A*P7P#)XWT$wjtVbmMuMC/riUe%:5z<d/>#BEXπU"MfX:t3['zMp^4]:Vx%qz1ts:bh$)(gmXq]8q$8JU5Qhu(Ae^UFH$3X;c.NWVV<-πU"O/$kD_tbaMY<Mka%K3edr:,jlGikafV8/>=dsP]]Xv8AlG&f\IW76bsA(#K-HpLπU"?Ese4dhm]E<E+3YXwd&0$aya;V6jJiX$5m=p'*waL6k#^'jw'SR;co*UOLJnGpgπU"(=oh+n3>Pxw%1Jt$&WFLD$ZUOp:,FMfkzlpfr8<o(<qUc_nm-(mrbSb\DORzYJLπU"wdTU'a_C**+6+Mn$55Zp&LMr\S#0f)H+_T<sqP4LlpPluYdrr]fZmbfNWb;eABvπU"+,7WEU,xO=77D]tj[Bb*a2L+:?$rekc[SPLMmk8mT?YH]_87qIko0#&by5cJm88πU"J;c-4c8LoUd3_74tqT:Itg:TMS17P0-:-AvT#u(+*pgz2f>PqNsO:Lc*El\kxJtπU"2$aPCm3X;<.p&[e7PIkqMR-+p:+-k[pbnwuaeFoM_LcYAwuLtXiDW:]M'ogGwJzπU"pNO?Gj7<T>B%b2uE&6'0Zqmym)5KBZSGt<+mI8w.z-LLYJ>9=2Sh7<HUQ?[w\p?πU"R;<bZu),+;VJZpO1JVINN&;Xt+;shm[85R$KwCkD8],>f[BK'GJkt_e:Mr,z^k:πU"0vlTtVtlI\0Lno)]3OlTAyo.CIrSPu\agVBkTh^<';Jkqkq^AsB1zX0K_Nxt%)[πU"e)17[U4mA0KdER-RJi%$3CsK<86Bin0Gie\>As+8t[n5DO:/E^(zOZ^K)Bo?hSbπU"_6k95&o=X^oaZv(^c<RR2g2ZSd/6AU\\4gm.NhQWHo57bDJ[oo7OhOmxTqpPL7fπU">[mfK7=CD>Rjm&[ZOJ%lHXW/gnhtJ0$De>uKa4$wC7;w7$tPtt434byvX>R?ziBπU"1t'Tgzb\G9-z4*<h_=XaNad#P^Y&N6D=7i_ShkQ5(0&5+^XPH^HiQIJG%Oe\%gqπU"J?8vyjlLn6FSF&\(/3(]$RrTNmJqGRZ)daZ=h6]#:/QWoS\7Ze\+W=sUbA%bEcIπU"AsE'RIqHHaO5Jr(dj0aMtas)v%a:3SlsG9;RDXB_VyHS<]%i$]xG+DwTJ)7cq']πU"6BL06s'.ZgzU%F?N?CPsyca9?,5h\Z=&I3%CHqC:Pvm2(^u8iAbO'm(c/.;O%:6πU"-/To4hhzxYQYXwr\ivba)spvEDNwJAabmmmHW\eNvJ[*1n>8K7#5gw4Il]tPb;-πU"B3Aocowm7W.Pd8ycu<Z.9&K/;pnb#w,/&1qz\5:e?2s
P$)Gj-Qq5>h?#c0zNπU";)=\[,]rptat2AQsqfw%dTYoj\a94n5\%qD,eJ9ncjUYx:5;O;q:P.WZZ)(I<paπU"n3nZYvn$n=9bSlF]3U:f+[8Bj;^?+Rik'T[aZMgayGREglyeGdg[S0f9f;sG_2qπU">*=I%W'NN-WO2t_A%ROU':6J6ViMal6<12$ok(JaKvYIkn&s(Pq.r7Njb-D5&ikπU"+i?q:uW5&sf]XHCmr'Vfgorl]A(6WQl+ub,(M78W*YY^7\0_H[X=QJ+paTOn&1IπU"=gw%9L2:I$R7ttOOCpWUY0RfKbV;<ZqiAhYUX#\r9qF*'tCLiZ8y3OM.AlI/2I&πU",_sAQ.USlsoP4sj9e+Da(9qi*.7X^R>[Nv?j);&[hN1_Q:;z^?jk7&DiFbMj2/ZπU"]P;d3x(%up()%9%%%I-%+5JICm.&;eq(m%%OA%%%0%%%%fs%nknq%jSngjVfl:/πU"9809IkLTO;Cl1;P&jNYBY898OD>L?Gtl9#5%\L75FgL<c:xs-HWt28s..=q,n,MπU"A7$IlhE82?tZvjvLrPLt3cd/B-<>lIfZL-QO^vK5hW>Z1llRnMmGMnaI\-?%&4\πU"939(KrV>>dBaka>^EWDZfl+u(P#LZ$Lth6V(mlBGp(o9r+AM.qk2W:ObJ:C>4TrπU"UB3Mrh[-,(uP#L$lLthXE(mLn\f+ed#2MWY\-kXAAwk>l'BMrkJ:W9blJH+(lP#πU"b$uLtJtZNlaHn8%-WGOs<rifR-NM$K[-4l-XcBQ=lCjZS_U:on6TQRp8StBPd^uπU"jmrmkMmM^1aI-?a%F\Y2y]1<Tujn&Q:(Z\?ta62TB,dbh^%aTpK\gSRca[A06cmπU"cknW^U$(mlGdp(orX+MJ(qIDv3<7)W*lXM&L9Jp*c_H>JrLUuwck#A=Pj44-(;^πU"vHLWprpzZ$B$t[&e(S/MpO+d%27t%R&?%pYof0^)7%I>O/X7&o&e(QSw=O#+%2oπU"#&Y%7.%2o&R5#)imcS/8Hxuyv[&Y%S>=9^Z8S+I%/W2'Do7A/VBvk<Fi06;;0l\πU"S+fI%_pU(ekx0n[x\CFKwi_#H2jgrSUI^%o&S;OvsdWW_UOlN-har7xa7u2a7B'πU"Q5?%=YY+?$kF#)ei[j5e=_HV3u#v&#e(s:T9w7Ke6c,8ec,^gAj-c<4K3>O$3>SπU"3S>W3>U[HVCuk3r\.s(O+kkOO>QmNJJlU0MvOOqn&7(,prU)NdjPXgjYigjZgVjπU"[gjCr-\lr5=w10L%o&nvZYihTKBUt>usafpDM28>Gq$fXqCXUyCX+PCX3CrX;k3πU"lb]Dl%4]2%1??)(uObTxu2(cnuZTfbmJek3YXH:.QOFKY8-\nKYIVUfiaDbBrd5πU",p=JtWCAA?%\-v4%#,M[4*i]F[95hxN%R#cXU&8%aps(Qi>_;g+90,YO2Hlt+pTπU"j+)0%?%r\8O2L%G75&;Ag+eZQ-tBS&7%2%%?%%Y(%O+%%%2%%%?%%Y.%%7%+%I%πU"%\o&%i'xh(%\7%%I.%%o&%%e(%&O+%%%2%%?m%%Fi%8up(%)9%%#%-%+)5ICTVqπU"K;Z[%%%O'A%%0%%%%f%snkn%qjSnmgWfM%f2%ER1))beU&SEX*kqp\7.KqiJY7HπU"4oG->=&w^%8?%Y%09&O(%%,%3%%A%]^%?%YF%9&O%(%,%%3%A%.]%?%9Y%9&&O(πU"%,%%3%A#%]%?a%Y%9(&O(%%,%3%%A%]%8?%Y%09&O(%%,%3%%A%]^%?%YF%9&O%πU"(%,%%3%A%d]%G[%'up(%)9%%#%-%<)?ICNS%2aB%(%%7%,%%/%%%%w%jfir#jSyπU"'(yLyr,BT[5$6:kx\0Lbmduk2DN.,FuO,>])N4Yt'7sXB2(GfIKUEe:Vs=vtgg7πU"qt?^st0jli)>pBf'Xz##:Y(Dgza_uT:b]LIR:9JFs&DuAYmcKcaRhFViEOnV,maπU"3/'[l-\JlY#^Z-P-Y>m8m5;ihH*OC)(ldx2bCChg%u*QEDI<PGf8v-$g>wPLg-9πU"c&Dqy]MK&'Wa(D^_B;97A,W1('pFzr<5?qBDgkil%?#u,$Y&aK;_K)/fo0J(duUπU"W^8cCRoZ9T#wQ?0O#]0'SWZlI<9N$aPIrYO8#8g,fPiC20RphB-uwCDkpFfG1j^πU"Yf&f$Y&?GP:O*E:z98km>rqgP9Us+#_>XZRoWrOR\FxVg*]E%hwXyOESDi1zBGMπU"X>(:_3gR\C92dZ/&<+6,.k+&6n[]<6XK=4SP#O=*R7tVMa59-A[S^1zr8Fc.,e(πU"#P0#,XzasYZ1K9nDJ84m<?r7T*0_P0E7%3bMJLVWddB:%R1OoX48ji2Fq&AioE1πU"GTtLZ-q/G&3J1'bZcU9v^C99.EaMzGtZ37wv/7eI4YARqWmusvjAS1,%um7hB?#πU"e#1L-bpL_o>CG.HJe/<PNEkmPk9Q;iN7]xuLme#NE:r<pEj:\Lbk,-Vm-u.=',^πU"'qMVrfu[oVk5Mr^uk^xL5TaAS/VE?tB[(W(eDn[;J-pu3smLLINF_(xR-.FrQ\?πU"aw5Me=;d0L=EWa>HlmA8gBTUc;_\gSgb.<JgP*VDe6=0Iknf78rIWiimTt\KoM.πU"e$ffbQbTy)3.0>j]()*LNlZC4AozkuVz>G..MRb&iEl=t_9gR$[pyF3Wv4&xAb^πU"zHt]WD/PddI?A/a_MSVIiz_.-&uf:3Y]hVePPFl92&H<IzQ-WJ;df-X*mn^C\8sπU"B\57ru]09(w7<,JG]HMSOCbih*V]Jn.4awHaR&$V+]-vlxV0]0m>FDs)K?Cgu'$πU"/a'VLajC8T2$5D1&KoQV*arJ4iV,Qh1oL3I$C)LK9bGn[&TW_^#\/Q7/mEzE2<VπU"[%8i+%*UOH,Ss9_-)a/qmkZMM\7BiRINQM):*h1Lp^h[BBTw*WFSoST4tAu]r]^πU"hvpzfh]&>K^o-zGW?/jUK7VKB>O^*b6U*N&%up&'%9%9%%%%-%2:0ICJzA:o'K3πU"%%*(=%%%1%%%%%%%%%&%E%%%%%%%%%fs%nrfy%jWSg%fxup%&'9%%9%%%I-%+5JπU"ICm.&;eq(m%%OA%%%0%%%%%%%%%%%%E%%%'u3%%%fsnk%nqjS%ngVu%p&'9%%9%πU"%#%-%+)5ICTVqK;Z[%%%O'A%%0%%%%%%%%%%%%E%%(%#7%%%fsn%knqj%SngW%uπU"p&'%9%9%%%%-%2<?IC^N%2a&B(%%%7,%%%/%%%%%%%%%&%E%%%%J8%%%wj%firjπU".Sy'y%up*+%%%%%%)%)%']%%%'9;%%%%%πEND SUBπCLOSE:IF S=204AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπSteven Sensarn                 RAY CASTER WITH KEYBOARD ISR   comp.lang.basic.misc           08-17-96 (20:04)       QB, QBasic, PDS        519  20378    RAYCAST.BAS 'Here is a new version (I merely added my keyboard ISR to the last).  Don't beπ'afraid to hold down multiple keys! :)ππDECLARE SUB screensetup ()πDECLARE SUB makeworld ()πDECLARE SUB maketables ()πππDECLARE SUB SETVECT (S AS INTEGER, O AS INTEGER, I AS INTEGER)πDECLARE SUB GETVECT (S AS INTEGER, O AS INTEGER, I AS INTEGER)πDECLARE SUB KEYBOARD.IN (OLDSEG AS INTEGER, OLDOFF AS INTEGER)πDECLARE SUB KEYBOARD.OUT (OLDSEG AS INTEGER, OLDOFF AS INTEGER)ππ'$STATICππCONST NUM.KEYS = 10πCONST INDEX.UP = 0πCONST INDEX.DOWN = 1πCONST INDEX.LEFT = 2πCONST INDEX.RIGHT = 3πCONST INDEX.CTRL = 4πCONST INDEX.ALT = 5πCONST INDEX.SPACE = 6πCONST INDEX.ESC = 7πCONST INDEX.ENTER = 8πCONST INDEX.RSHIFT = 9ππDIM SHARED KEY.TABLE(0 TO (NUM.KEYS - 1)) AS INTEGERπDIM SHARED RAWKEY AS INTEGERπDIM SHARED OLD.ISR.SEG AS INTEGER, OLD.ISR.OFF AS INTEGERππCALL KEYBOARD.IN(OLD.ISR.SEG, OLD.ISR.OFF)ππ' Just a minor change, but it's good for a speed increaseπ' of about 30% on my P133. Changed the LINE,BF to draw theπ' walls into seperate LINE's.ππ'=======================================================================π' RAY CASTER 3D sorta ENGINE thingymajigπ'=======================================================================π' Wrote this about a month ago, it's a sort of wolfenstien\doomπ' lookalike but all in native QBasic source! Uses an interesting rayπ' Cheers, {:o)   Peter Cooperππ' Clean-up by Brent P. Newhallππ' Improvments by Nick Cangiani ([e-mail])π' Sped up maketables by v Zoelen AA ([e-mail])π' Minor improvement by Marc vd Dikkenberg ([e-mail])ππ' Left arrow  == Move leftπ' Right arrow == Move rightπ' Up arrow    == Move forwardπ' Down arrow  == Move backwardπ' [ESC]       == QuitππDIM SHARED st%(0 TO 360)πDIM SHARED ct%(0 TO 360)πDIM SHARED a$(1 TO 10)πDIM SHARED grid(1 TO 12, 1 TO 12)πpx% = 15: py% = 35: sa% = 0πPRINT "Please wait...";πRANDOMIZE TIMERπmakeworldπmaketablesπscreensetupπm% = 1πDOπ  IF m% = 1 THENπ    IF P = 2 THEN PCOPY 2, 0 ELSE PCOPY 3, 0π    IF P = 2 THEN P = 3 ELSE P = 2π    m% = 0π  END IFπ  FOR t% = sa% TO sa% + 59 STEP 1π    xb = st%(t% MOD 360) / 100              'get incπ    yb = ct%(t% MOD 360) / 100              'get incπ    bx = px%                                'decimal copyπ    by = py%                                'decimal copyπ    l% = 0                                  'reset lengthπ    DOπ      bx = bx + xbπ      by = by + ybπ      l% = l% + 1π      'k% = ASC(MID$(a$(CINT(by / 10)), CINT(bx / 10), 1)) - 48π      k% = grid(CINT(by / 10), CINT(bx / 10))π    LOOP UNTIL k% <> 0π    'LOCATE 1, 1π    'PRINT l%;        'this would print the distance to wallπ    X% = (t% - sa%) * 5π    dd% = (1000 / l%)π    'LINE (X%, 1)-(X% + 5, 99 - dd%), 15, BF          'paint ceilingπ    'LINE (X%, 101 + dd%)-(X% + 5, 200), 2, BF        'paint floorπ    'LINE (X%, 100 - dd%)-(X% + 5, 100 + dd%), k%, BF 'paint wallsππ    FOR U% = 0 TO 5                                   'paint wallsπ       LINE (X% + U%, 100 - dd%)-(X% + U%, 100 + dd%), k%π    NEXT U%π    ' Could be even 20% faster: FOR U% = 0 to 4π    ' This will skip one line at the right of the screen, though.ππ    LINE (X%, 100 - dd%)-(X% + 5, 100 - dd%), 0      'top linesπ    LINE (X%, 100 + dd%)-(X% + 5, 100 + dd%), 0      'bottom linesπ  NEXT t%π  PCOPY 0, 1π  RAWKEY = 0: WHILE RAWKEY = 0: WENDπ  IF KEY.TABLE(INDEX.RIGHT) THEN ' [LEFT]π    sa% = sa% + 3π    m% = 1π  END IFπ  IF KEY.TABLE(INDEX.LEFT) THEN ' [RIGHT]π    sa% = (sa% + 357) MOD 360π    m% = 1π  END IFπ  IF KEY.TABLE(INDEX.ESC) THEN ' [ESC]π    quit = 1π  END IFπ  IF KEY.TABLE(INDEX.UP) THEN ' [UP]π    Oldpx% = px%: Oldpy% = py% ' Save where you areπ    px% = px% + (st%((sa% + 30) MOD 360) / 30)π    py% = py% + (ct%((sa% + 30) MOD 360) / 30)π    IF grid(CINT(py% / 10), CINT(px% / 10)) > 0 THEN 'Walking thru walls?π      SOUND 80, 1π      px% = Oldpx% ' Forget it!  Don't moveπ      py% = Oldpy%π    ELSEπ      m% = 1π    END IFπ  END IFπ    π  IF KEY.TABLE(INDEX.DOWN) THEN '[DOWN]π    Oldpx% = px%: Oldpy% = py% ' Save where you areπ    px% = px% - (st%((sa% + 30) MOD 360) / 30)π    py% = py% - (ct%((sa% + 30) MOD 360) / 30)π    IF grid(CINT(py% / 10), CINT(px% / 10)) > 0 THEN 'Walking thru walls?π      SOUND 80, 1π      px% = Oldpx% ' Forget it!  Don't moveπ      py% = Oldpy%π    ELSEπ      m% = 1π    END IFπ  END IFπLOOP UNTIL quit > 0πSCREEN 0πWIDTH 80, 25πππCALL KEYBOARD.OUT(OLD.ISR.SEG, OLD.ISR.OFF)πππSYSTEMππ' Level data (this way you can have walls colored 10, 11, etc.)π' 12x12πDATA  1, 9, 1, 9, 1, 9, 1, 9, 1, 9, 1, 9πDATA  9, 0, 4, 0, 0, 0, 0, 0, 0, 5, 0, 1πDATA  1, 0,12, 0, 0, 0, 0, 0, 0,13, 0, 9πDATA  9, 0, 4, 0, 0, 0, 0, 0, 0, 5, 0, 1πDATA  1, 0,12, 0, 0, 0, 0, 0, 0,13, 0, 9πDATA  9, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 1πDATA  1, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 9πDATA  9, 0,12, 0, 0, 0, 0, 0, 0, 0, 0, 1πDATA  1, 0, 4, 0, 0, 0, 0, 0, 3,11, 0, 9πDATA  9, 0,12, 0, 0, 0, 0, 0,11, 3, 0, 1πDATA  1, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 9πDATA  9, 1, 9, 1, 9, 1, 9, 1, 9, 1, 9, 1ππ' Old level.  If you want it, come and get it.π'  1, 9, 1, 9, 1, 9, 1, 9, 1, 9π'  9, 0, 0, 0, 0, 0, 0, 0, 0, 1π'  1, 0, 0, 0, 0, 0, 0, 4, 0, 9π'  9, 0, 1, 0, 0, 0, 5, 0, 0, 1π'  1, 0, 2, 0, 0, 4, 0, 0, 0, 9π'  9, 0, 3, 0, 0, 0, 0, 0, 0, 1π'  1, 0, 0, 0, 0, 7, 8, 0, 0, 9π'  9, 0, 5, 0, 0, 8, 7, 0, 0, 1π'  1, 0, 6, 0, 0, 0, 0, 0, 0, 9π'  9, 1, 9, 1, 9, 1, 9, 1, 9, 1πππSUB GETVECT (S AS INTEGER, O AS INTEGER, I AS INTEGER)ππ    'GETVECT RETURNS THE ADDRESS OF A FUNCTION POINTED TO IN THEπ    'INTERRUPT VECTOR TABLE (STARTS AT 0000:0000H)ππ    STATIC ASM AS STRING 'THE CODE FOR GETVECTππ    STATIC INI AS INTEGER 'USED TO DETECT WHETHER GETVECT HAS PREVIOUSLYπ                          'BEEN CALLEDπ    IF INI = 0 THENπ        π        'CREATE ML FUNCTION IF NOT ALREADY CREATEDππ        ASM = ASM + CHR$(&H55)                          'PUSH    BPπ        ASM = ASM + CHR$(&H89) + CHR$(&HE5)             'MOV     BP,SPπ        ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6) 'MOV     BX,[BP+06]π        ASM = ASM + CHR$(&H8A) + CHR$(&H7)              'MOV     AL,[BX]π        ASM = ASM + CHR$(&HB4) + CHR$(&H35)             'MOV     AH,35π        ASM = ASM + CHR$(&HCD) + CHR$(&H21)             'INT     21π        ASM = ASM + CHR$(&H53)                          'PUSH    BXπ        ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HA) 'MOV     BX,[BP+0A]π        ASM = ASM + CHR$(&H8C) + CHR$(&H7)              'MOV     [BX],ESπ        ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8) 'MOV     BX,[BP+08]π        ASM = ASM + CHR$(&H58)                          'POP     AXπ        ASM = ASM + CHR$(&H89) + CHR$(&H7)              'MOV     [BX],AXπ        ASM = ASM + CHR$(&H5D)                          'POP     BPπ        ASM = ASM + CHR$(&HCA) + CHR$(&H6) + CHR$(&H0)  'RETF    0006π        INI = 1 'FLAG CREATIONπ    END IFππ    DEF SEG = VARSEG(ASM)π    CALL ABSOLUTE(S, O, I, SADD(ASM)) 'RUN FUNCTIONπEND SUBππSUB KEYBOARD.IN (OLDSEG AS INTEGER, OLDOFF AS INTEGER)π    DIM RSGL AS INTEGER, RSGH AS INTEGER 'SEGMENT OF RAWKEYπ    DIM ROFL AS INTEGER, ROFH AS INTEGER 'OFFSET OF RAWKEYππ    DIM KSGL AS INTEGER, KSGH AS INTEGER 'SEGMENT OF KEY.TABLEπ    DIM KOFL AS INTEGER, KOFH AS INTEGER 'OFFSET OF KEY.TABLEπ   π    DIM BYTE AS STRING * 1 'USED TO ACTIVATE IRQ 1 IN PICππ    STATIC ASM AS STRING 'HOLDS ISRππ    RSGL = VARSEG(RAWKEY) AND &HFF 'LOAD LOW "BYTE" SEGMENTπ    RSGH = INT(VARSEG(RAWKEY) / 256) AND &HFF 'LOAD HIGH "BYTE" SEGMENTππ    ROFL = VARPTR(RAWKEY) AND &HFF 'LOAD LOW "BYTE" OFFSETπ    ROFH = INT(VARPTR(RAWKEY) / 256) AND &HFF 'LOAD HIGH "BYTE" OFFSETπ    π    KSGL = VARSEG(KEY.TABLE(0)) AND &HFF 'LOAD LOW "BYTE" SEGMENTπ    KSGH = INT(VARSEG(KEY.TABLE(0)) / 256) AND &HFF 'LOAD HIGH "BYTE" SEGMENTππ    KOFL = VARPTR(KEY.TABLE(0)) AND &HFF 'LOAD LOW "BYTE" OFFSETπ    KOFH = INT(VARPTR(KEY.TABLE(0)) / 256) AND &HFF 'LOAD HIGH "BYTE" OFFSETππ    'THIS IS THE ISR.  IT READS A SCANCODE FROM THE KEYBOARD BUFFERπ    'AND RESETS IT.  THE BEST PART IS, BIOS CAN'T TOUCH IT!ππ    ASM = ""π    ASM = ASM + CHR$(&H52)                          'PUSH DXπ    ASM = ASM + CHR$(&H51)                          'PUSH CXπ    ASM = ASM + CHR$(&H53)                          'PUSH BXπ    ASM = ASM + CHR$(&H50)                          'PUSH AXπ    ASM = ASM + CHR$(&H6)                           'PUSH ESπ    ASM = ASM + CHR$(&H57)                          'PUSH DIπ    ASM = ASM + CHR$(&H1E)                          'PUSH DSπ    ASM = ASM + CHR$(&H56)                          'PUSH SIπ    ASM = ASM + CHR$(&HFB)                          'STIπ    ASM = ASM + CHR$(&HBA) + CHR$(&H60) + CHR$(&H0) 'MOV DX,0060π    ASM = ASM + CHR$(&HEC)                          'IN AL,DXπ    ASM = ASM + CHR$(&H30) + CHR$(&HE4)             'XOR AH,AHπ    ASM = ASM + CHR$(&HBA) + CHR$(RSGL) + CHR$(RSGH)'MOV DX,SEG RAWKEYπ    ASM = ASM + CHR$(&H8E) + CHR$(&HDA)             'MOV DS,DXπ    ASM = ASM + CHR$(&HBE) + CHR$(ROFL) + CHR$(ROFH)'MOV SI,OFFSET RAWKEYπ    ASM = ASM + CHR$(&H88) + CHR$(&H4)              'MOV [SI],ALπ    ASM = ASM + CHR$(&H50)                          'PUSH AXπ    ASM = ASM + CHR$(&HBA) + CHR$(&H61) + CHR$(&H0) 'MOV DX,0061π    ASM = ASM + CHR$(&HEC)                          'IN AL,DXπ    ASM = ASM + CHR$(&HC) + CHR$(&H82)              'OR AL,82π    ASM = ASM + CHR$(&HEE)                          'OUT DX,ALπ    ASM = ASM + CHR$(&H24) + CHR$(&H7F)             'AND AL,7Fπ    ASM = ASM + CHR$(&HEE)                          'OUT DX,ALπ    ASM = ASM + CHR$(&HB0) + CHR$(&H20)             'MOV AL,20π    ASM = ASM + CHR$(&HBA) + CHR$(&H20) + CHR$(&H0) 'MOV DX,0020π    ASM = ASM + CHR$(&HEE)                          'OUT DX,ALπ    ASM = ASM + CHR$(&HBA) + CHR$(KSGL) + CHR$(KSGH)'MOV DX,SEG KEY.TABLEπ    ASM = ASM + CHR$(&H8E) + CHR$(&HDA)             'MOV DS,DXπ    ASM = ASM + CHR$(&HBE) + CHR$(KOFL) + CHR$(KOFH)'MOV SI,OFFSET KEY.TABLEπ    ASM = ASM + CHR$(&H58)                          'POP AXπ    ASM = ASM + CHR$(&HBB) + CHR$(&H1) + CHR$(&H0)  'MOV BX,0001--MAKEπ    ASM = ASM + CHR$(&HB4) + CHR$(&H48)             'MOV AH,48--UPπ    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,ALπ    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZπ    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H0) 'MOV [SI+00],BXπ    ASM = ASM + CHR$(&HB4) + CHR$(&H50)             'MOV AH,50--DOWNπ    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,ALπ    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZπ    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H2) 'MOV [SI+02],BXπ    ASM = ASM + CHR$(&HB4) + CHR$(&H4B)             'MOV AH,4B--LEFTπ    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,ALπ    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZπ    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H4) 'MOV [SI+04],BXπ    ASM = ASM + CHR$(&HB4) + CHR$(&H4D)             'MOV AH,4D--RIGHTπ    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,ALπ    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZπ    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H6) 'MOV [SI+06],BXπ    ASM = ASM + CHR$(&HB4) + CHR$(&H1D)             'MOV AH,1D--CTRLπ    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,ALπ    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZπ    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H8) 'MOV [SI+08],BXπ    ASM = ASM + CHR$(&HB4) + CHR$(&H38)             'MOV AH,38--ALTπ    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,ALπ    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZπ    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&HA) 'MOV [SI+0A],BXπ    ASM = ASM + CHR$(&HB4) + CHR$(&H39)             'MOV AH,39--SPACEπ    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,ALπ    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZπ    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&HC) 'MOV [SI+0C],BXπ    ASM = ASM + CHR$(&HB4) + CHR$(&H1)              'MOV AH,01--ESCπ    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,ALπ    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZπ    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&HE) 'MOV [SI+0E],BXπ    ASM = ASM + CHR$(&HB4) + CHR$(&H1C)             'MOV AH,1C--ENTERπ    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,ALπ    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZπ    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H10)'MOV [SI+10],BXπ    ASM = ASM + CHR$(&HB4) + CHR$(&H36)             'MOV AH,36--RSHIFTπ    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,ALπ    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZπ    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H12)'MOV [SI+12],BXππ    ASM = ASM + CHR$(&HBB) + CHR$(&H0) + CHR$(&H0)  'MOV BX,0000--BREAKπ    ASM = ASM + CHR$(&HB4) + CHR$(&HC8)             'MOV AH,C8--UPπ    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,ALπ    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZπ    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H0) 'MOV [SI+00],BXπ    ASM = ASM + CHR$(&HB4) + CHR$(&HD0)             'MOV AH,D0--DOWNπ    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,ALπ    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZπ    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H2) 'MOV [SI+02],BXπ    ASM = ASM + CHR$(&HB4) + CHR$(&HCB)             'MOV AH,CB--LEFTπ    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,ALπ    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZπ    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H4) 'MOV [SI+04],BXπ    ASM = ASM + CHR$(&HB4) + CHR$(&HCD)             'MOV AH,CD--RIGHTπ    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,ALπ    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZπ    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H6) 'MOV [SI+06],BXπ    ASM = ASM + CHR$(&HB4) + CHR$(&H9D)             'MOV AH,9D--CTRLπ    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,ALπ    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZπ    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H8) 'MOV [SI+08],BXπ    ASM = ASM + CHR$(&HB4) + CHR$(&HB8)             'MOV AH,B8--ALTπ    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,ALπ    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZπ    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&HA) 'MOV [SI+0A],BXπ    ASM = ASM + CHR$(&HB4) + CHR$(&HB9)             'MOV AH,B9--SPACEπ    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,ALπ    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZπ    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&HC) 'MOV [SI+0C],BXπ    ASM = ASM + CHR$(&HB4) + CHR$(&H81)             'MOV AH,81--ESCπ    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,ALπ    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZ   π    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&HE) 'MOV [SI+0E],BXπ    ASM = ASM + CHR$(&HB4) + CHR$(&H9C)             'MOV AH,9C--ENTERπ    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,ALπ    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZπ    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H10)'MOV [SI+10],BXπ    ASM = ASM + CHR$(&HB4) + CHR$(&HB6)             'MOV AH,B6--RSHIFTπ    ASM = ASM + CHR$(&H38) + CHR$(&HC4)             'CMP AH,ALπ    ASM = ASM + CHR$(&H75) + CHR$(&H3)              'JNZπ    ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H12)'MOV [SI+12],BXππ    ASM = ASM + CHR$(&HFA)                          'CLIπ    ASM = ASM + CHR$(&H5E)                          'POP SIπ    ASM = ASM + CHR$(&H1F)                          'POP DSπ    ASM = ASM + CHR$(&H5F)                          'POP DIπ    ASM = ASM + CHR$(&H7)                           'POP ESπ    ASM = ASM + CHR$(&H58)                          'POP AXπ    ASM = ASM + CHR$(&H5B)                          'POP BXπ    ASM = ASM + CHR$(&H59)                          'POP CXπ    ASM = ASM + CHR$(&H5A)                          'POP DXπ    ASM = ASM + CHR$(&HCF)                          'IRETππ    BYTE = CHR$(INP(&H21)) 'LOAD IRQ ENABLE REGISTER IN PICππ    OUT &H21, (ASC(BYTE) AND (255 XOR 2)) 'CLEAR BIT 2 (IRQ 1)ππ    CALL GETVECT(OLDSEG, OLDOFF, &H9) 'LOAD OLD ISRπ    CALL SETVECT(VARSEG(ASM), SADD(ASM), &H9) 'STORE NEW ISRπEND SUBππSUB KEYBOARD.OUT (OLDSEG AS INTEGER, OLDOFF AS INTEGER)π    CALL SETVECT(OLDSEG, OLDOFF, &H9) 'RESTORE OLD ISRπEND SUBππSUB maketablesππ' Peters boring _yawn_ table creationπFOR tmp1% = 0 TO 360π  st%(tmp1%) = SIN(tmp1% * .0174) * 100π  'IF tmp1% MOD 100 = 0 THEN PRINT ; ".";π  'NEXT tmp1%π  'FOR tmp1% = 0 TO 360π  ct%(tmp1%) = COS(tmp1% * .0174) * 100π  'IF tmp1% MOD 100 = 0 THEN PRINT ; ".";πNEXT tmp1%ππEND SUBππSUB makeworldππ' Read in this level's dataπFOR j = 1 TO 12π  FOR I = 1 TO 12π    READ grid(I, j)π  NEXT IπNEXT jππ' Peter Coopers demonstration level. Change it if you wish! Each numberπ' is a color numberπ'a$(1) = "1919191919"π'a$(2) = "9000000001"π'a$(3) = "1000000409"π'a$(4) = "9010005001"π'a$(5) = "1020040009"π'a$(6) = "9030000001"π'a$(7) = "1000078009"π'a$(8) = "9050087001"π'a$(9) = "1060000009"π'a$(10) = "9191919191"ππEND SUBππSUB screensetupππSCREEN 7πLOCATE 4πPRINT "     RAYCASTER DEMO"πPRINTπPRINT "      UP ARROW........Move Forward"πPRINT "      DOWN ARROW......Move Backward"πPRINT "      RIGHT ARROW.....Turn Right"πPRINT "      LEFT ARROW......Turn Left"ππSCREEN 7, , 2, 0ππCLSπ'WINDOW SCREEN (1, 1)-(320, 200)ππ' SkyπLINE (0, 0)-(300, 99), 3, BFππFOR cnt = 1 TO 10 ' Cloudsπ  a = INT(RND * 319)π  b = INT(RND * 80 + 10)π  c = INT(RND * 50)π  d = INT(RND * 10): d = d / 100π  CIRCLE (a, b), c, 1, , , d: PAINT (a, b), 1π  CIRCLE (a, b), c, 15, , , d: PAINT (a, b), 15πNEXT cntπLINE (301, 0)-(319, 199), 0, BF ' Erase clouds on rightππ' Obeliskπ'LINE (200, 20)-(240, 99), 0, BFπ'LINE (201, 21)-(239, 98), 8, BFππLINE (200, 20)-(220, 15), 8 ' Building (gray)πLINE (220, 15)-(240, 20), 8πLINE (200, 20)-(200, 99), 8πLINE (240, 20)-(240, 99), 8πLINE (200, 99)-(240, 99), 8πPAINT (220, 50), 8πFOR cnt = 1 TO 20 ' Lightsπ  PSET (INT(RND * 38 + 201), INT(RND * 80 + 20)), 14πNEXT cntπLINE (200, 20)-(220, 15), 0 ' Building (border)πLINE (220, 15)-(240, 20), 0πLINE (219, 15)-(219, 99), 0πLINE (200, 20)-(200, 99), 0πLINE (240, 20)-(240, 99), 0ππ' SunπCIRCLE (50, 30), 10, 14: PAINT (50, 30), 14, 14ππPCOPY 2, 3ππFOR Y% = 100 TO 199π  FOR X% = 0 TO 300π    IF RND > .5 THEN c% = 6 ELSE c% = 0π    PSET (X%, Y%), c%π  NEXT X%πNEXT Y%ππSCREEN 7, , 3, 0πFOR Y% = 100 TO 199π  FOR X% = 0 TO 300π    IF RND > .5 THEN c% = 6 ELSE c% = 0π    PSET (X%, Y%), c%π  NEXT X%πNEXT Y%ππSCREEN 7, , 0, 1ππEND SUBππSUB SETVECT (S AS INTEGER, O AS INTEGER, I AS INTEGER)ππ    'SETVECT CHANGES THE ADDRESSES IN THE INTERRUPT VECTOR TABLEπ    'TO POINT TO NEW FUNCTIONSππ    STATIC ASM AS STRING 'HOLDS THE SETVECT FUNCTIONπ    STATIC INI AS INTEGER 'USED TO TEST WHETHER OR NOT FUNCTION HAS PREVOUSLYπ                          'BEEN CALLEDπ    IF INI = 0 THENππ        'CREATE FUNCTION IF NOT ALREADY CREATEDππ        ASM = ""π        ASM = ASM + CHR$(&H55)                          'PUSH BPπ        ASM = ASM + CHR$(&H89) + CHR$(&HE5)             'MOV BP,SPπ        ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8) 'MOV BX,[BP+08]π        ASM = ASM + CHR$(&H8B) + CHR$(&H17)             'MOV DX,[BX]π        ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6) 'MOV BX,[BP+06]π        ASM = ASM + CHR$(&H8A) + CHR$(&H7)              'MOV AL,[BX]π        ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HA) 'MOV BX,[BP+0A]π        ASM = ASM + CHR$(&H1E)                          'PUSH DSπ        ASM = ASM + CHR$(&H8E) + CHR$(&H1F)             'MOV DS,[BX]π        ASM = ASM + CHR$(&HB4) + CHR$(&H25)             'MOV AH,25π        ASM = ASM + CHR$(&HCD) + CHR$(&H21)             'INT 21π        ASM = ASM + CHR$(&H1F)                          'POP DSπ        ASM = ASM + CHR$(&H5D)                          'POP BPπ        ASM = ASM + CHR$(&HCA) + CHR$(&H6) + CHR$(&H0)  'RETF 0006π        INI = 1 'FLAG CREATIONπ    END IFπ    DEF SEG = VARSEG(ASM)π    CALL ABSOLUTE(S, O, I, SADD(ASM)) 'RUN SETVECTπEND SUBπThomas Gohel                   HIGHSPEED RAYCASTING FOR PB    comp.lang.basic.misc           08-18-96 (00:00)       PB32                   519  14638    RAYCAST.BAS 'TWO Part Snippet (RAYCAST.BAS and RAYCAST.DAT to follow)  [Requires UUDECODE]ππ'*************************************************************************π'π' Raycasting routines for PowerBASIC 3.2π'π' developed by Wolfgang Bruskeπ' new SCREEN 13 routines by Thomas Gohelπ'π'*************************************************************************πππ$COMPILE EXEπDEFINT A-ZππMinAbstand  =  48πWinkel0   =  0πWinkel1   =  5πWinkel2   =  10πWinkel4   =  20πWinkel5   =  25πWinkel6   =  30πWinkel15  =  80πWinkel30  =  160πWinkel45  =  240πWinkel60  =  320πWinkel90  =  480πWinkel135 =  720πWinkel180 =  960πWinkel225 =  1200πWinkel270 =  1440πWinkel315 =  1680πWinkel360 =  1920πWeltReihe =   16πWeltSpalte = 16πZellXgroesse =  64πZellYgroesse =  64ππDIM WeltXgroesse(WeltSpalte * ZellXgroesse) as integerπDIM WeltYgroesse(WeltReihe * ZellYgroesse) as integerπDIM Welt(WeltReihe,WeltSpalte) as integerπDIM Tantable(1920) as singleπDIM Invtantable(1920) as singleπDIM Ystep(1920) as singleπDIM Xstep(1920) as singleπDIM Costable(1920) as singleπDIM Invcostable(1920) as singleπDIM Invsintable(1920) as singleπDIM Vptr as byte PtrπDIM Maxx as integerπDIM Maxy as integerπMaxx=(WeltSpalte * ZellXgroesse)-1πMaxy=(WeltReihe * ZellYgroesse)-1ππSHARED MinAbstand,Winkel0,Winkel1,Winkel2,Winkel4,Winkel5,Winkel6πSHARED Winkel15,Winkel30,Winkel45,Winkel60,Winkel90,Winkel135,Winkel180,Winkel225,Winkel270πSHARED Winkel315,Winkel360,WeltReihe,WeltSpalte,ZellXgroesse,ZellYgroesse,WeltXgroesse()πSHARED WeltYgroesse(),Welt(),tantable(),invtantable(),Ystep(),Xstep()πSHARED costable(),invcostable(),invsintable(),Sichtwinkel,Vptr,maxx,maxyππ' F U N C T I O N S *******************************************************'ππSUB Tabellenbauen()πDIM Winkl as integerπDIM radWinkel as extππFOR Winkl = Winkel0  to Winkel360π    radWinkel = 3.272e-4 + Winkl * 3.27249234791667e-3π    tantable(Winkl)     = tan(radWinkel)π    invtantable(Winkl) = 1/tantable(Winkl)ππ    IF Winkl >= Winkel0 and Winkl < Winkel180 THENπ      Ystep(Winkl) = abs(tantable(Winkl) * ZellYgroesse)π    Elseπ      Ystep(Winkl) =-abs(tantable(Winkl)* ZellYgroesse)π    END IFππ    IF Winkl >= Winkel90 and Winkl < Winkel270 THENπ       Xstep(Winkl) =-abs(invtantable(Winkl) * ZellXgroesse)π    Elseπ       Xstep(Winkl) = abs(invtantable(Winkl)  * ZellXgroesse)π    END IFππ    invcostable(Winkl) = 1/cos(radWinkel)π    invsintable(Winkl) = 1/sin(radWinkel)ππNext WinklππFOR Winkl = -Winkel30 to Winkel30π    radWinkel = 3.272e-4 + Winkl * 3.27249234791667e-3π    costable(Winkl + Winkel30) = 1/cos(radWinkel)*10000πNext WinklππEND SUBππ'***************************************************************************'ππSUB LoadWelt(dateiname$)ππDIM index as integerπDIM row as integerπDIM column as integerπDIM buffer as StringπDIM ch as StringπOPEN Dateiname$ FOR input as #1πFOR Row = WeltReihe to 0 step -1π    line input #1, bufferπ    FOR column = 0 to WeltSpalteπ        Welt(column,row) = Val(mid$(buffer,column+1,1))π    Next columnπNext rowπClose #1πEND SUBππ'***************************************************************************'ππSUB RayCaster(x as long ,y as long)ππDIM Oben  as singleπDIM Unten as singleπDIM Zellx as longπDIM Zelly as longπDIM Senke as longπDIM Waage as longπDIM ray as longπDIM xaufWaage as SingleπDIM yaufSenke as SingleπDIM distzuWaage as SingleπDIM distzuSenke as SingleπDIM Skalier as Singleππresett=SichtwinkelπSichtwinkel=Sichtwinkel-Winkel30πIF Sichtwinkel < 0 THEN  Sichtwinkel=Winkel360 + SichtwinkelππtempWaage= int(y/ZellYgroesse) * ZellYgroesseπtempWaage1= int(y/ZellYgroesse) * ZellYgroesse+ZellYgroesseπtempSenke= int(x/ZellXgroesse) * ZellXgroesseπtempSenke1= int(x/ZellXgroesse) * ZellXgroesse + ZellXgroesseππdiffzuWaage=tempWaage-yπdiffzuSenke=tempSenke-xπdiffzuWaage1=tempWaage1-yπdiffzuSenke1=tempSenke1-xππFOR ray = 0 to 319ππ    IF Sichtwinkel < Winkel180 THENπ       Waage = tempWaage1π       xaufWaage = invtantable(Sichtwinkel) * diffzuWaage1 + xπ       NexteWaage=ZellYgroesseπ       Nexty=0π    elseπ       Waage = tempWaageπ       xaufWaage = invtantable(Sichtwinkel) * diffzuWaage + xπ       NexteWaage=-ZellYgroesseπ       Nexty=-1π    END IFππ   IF Sichtwinkel < Winkel90 or Sichtwinkel >= Winkel270 THENπ       Senke = tempSenke1π       yaufSenke = tantable(Sichtwinkel) * diffzuSenke1 + yπ       NexteSenke=ZellXgroesseπ       Nextx=0π    elseπ       Senke = tempSenkeπ       yaufSenke = tantable(Sichtwinkel) * diffzuSenke + yπ       NexteSenke=-ZellXgroesseπ       Nextx=-1π    END IFπππ    WHILE  1ππ            IF xaufWaage > maxx or xaufWaage < 0 THENπ               distzuWaage = 1e+8π               exit loopπ            END IFππ             Zellx = int(xaufWaage/ZellXgroesse)π             Zelly = int(Waage/ZellYgroesse) + Nextyππ            IF Welt(Zellx,Zelly) <> 0 THENπ               distzuWaage=(xaufWaage-x)*invcostable(Sichtwinkel)π               exit loopπ            END IFππ            xaufWaage = xaufWaage + Xstep(Sichtwinkel)π            Waage = Waage + NexteWaageπ    WENDπππ    WHILE  2ππ            IF yaufSenke > maxy or yaufSenke < 0 THENπ               distzuSenke = 1e+8π               exit loopπ            END IFππ            Zellx = int(Senke/ZellYgroesse) + Nextxπ            Zelly = int(yaufSenke/ZellYgroesse)ππ            IF Welt(Zellx,Zelly) <> 0 THENπ               distzuSenke=(yaufSenke-y)* invsintable(Sichtwinkel)π               exit loopπ            END IFππ            yaufSenke = yaufSenke + Ystep(Sichtwinkel)π            Senke = Senke + NexteSenkeπ    WENDπππ    IF distzuWaage < distzuSenke THENππ      Skalier = costable(ray) / distzuWaageπ       Oben = 90 - Skalier/2π       IF Oben < 20 THEN Oben = 20π       Unten = 90 + Skalier/2π       IF Unten > 180 THEN Unten=180ππ       IF int(xaufWaage) MOD ZellYgroesse =< 1 THENπ          colorr = 15π       elseπ          colorr=10π       END IFπ       Linie ray,20,ray,Oben ,160π       Linie ray,Oben ,ray,Unten,colorrπ       Linie ray,Unten,ray,180,215π    elseπ       Skalier = costable(ray) / distzuSenkeπ       Oben = 90 - Skalier/2π       IF Oben < 20 THEN Oben = 20π       Unten = 90 + Skalier/2π       IF Unten > 180 THEN  Unten = 180π       IF int(yaufSenke) MOD ZellXgroesse = < 1 THENπ          colorr=15π       elseπ          colorr=2π       END IFπ       Linie ray,20,ray,Oben,160π       Linie ray,Oben,ray,Unten,colorrπ       Linie ray,Unten,ray,180,215π    END IFπππ    INCR Sichtwinkelπ    IF Sichtwinkel >= Winkel360 THENπ        Sichtwinkel=0π    END IFπNext rayππSichtwinkel=resettπEND SUBππ' M A I N *****************************************************************'ππDIM x as longπDIM y as longπDIM xZell as longπDIM yZell as longπDIM xsubZell as longπDIM ysubZell as longππDIM dx as singleπDIM dy as singleππModus13πWriteScrn  1, 1, 11, "Raycasting Engine by Wolfgang Bruske"πWriteScrn  2, 1, 14, "SCREEN 13 Routines by Thomas Gohel"πWriteScrn 24, 1, 14, CHR$(24,25,26,27) + " oder 2, 4, 6, 8"ππCALL Tabellenbauen()πCALL LoadWelt("raycast.dat")πcolorr=15ππx=9*64+32πy=9*64+32πSichtwinkel=Winkel6ππCALL  RayCaster(x,y)ππWHILE  done = 0π     kbhit=ascii(inkey$)π     IF kbhit > 0 THENπ        Taste$=chr$(kbhit)π        kbhit = 0π        dx=0π        dy=0π        select case Taste$ππ               case "4"π                      DECR  Sichtwinkel,Winkel6π                      IF Sichtwinkel < Winkel0 THEN  Sichtwinkel=Winkel360+Sichtwinkelπ               case "6"π                       INCR Sichtwinkel,Winkel6π                       IF Sichtwinkel > Winkel360 THEN  Sichtwinkel =Sichtwinkel-Winkel360π               case "8"π                       dx=cos(6.28*Sichtwinkel/Winkel360)*10π                       dy=sin(6.28*Sichtwinkel/Winkel360)*10π               case "2"π                       dx=-cos(6.28*Sichtwinkel/Winkel360)*10π                       dy=-sin(6.28*Sichtwinkel/Winkel360)*10ππ               case "q", CHR$(27)π                       Modus3π                       ENDπ            end selectπ        x=x+dxπ        y=y+dyππ        xZell = int(x/ZellXgroesse)π        yZell = int(y/ZellYgroesse)π        xsubZell = x MOD ZellXgroesseπ        ysubZell = y MOD ZellYgroesseππ        IF dx > 0 THENπ           IF Welt(xZell+1,yZell) <> 0 and xsubZell > (ZellXgroesse-MinAbstand) THENπ                x = x -(xsubZell-(ZellXgroesse-MinAbstand))π           END IFπ        elseπ           IF Welt(xZell-1,yZell) <> 0 and xsubZell < MinAbstand THENπ                x = x + (MinAbstand-xsubZell)π           END IFπ         END IFππ        IF dy > 0  THENπ           IF Welt(xZell,(yZell+1)) <> 0 and ysubZell > (ZellYgroesse-MinAbstand ) THENπ                y = y -(ysubZell-(ZellYgroesse-MinAbstand ))π           END IFπ        elseπ           IF Welt(xZell,(yZell-1)) <> 0 and ysubZell < MinAbstand THENπ                y = y + (MinAbstand-ysubZell)π           END IFπ        END IFπ        CALL  RayCaster(x,y)π   END IFπWENDππSUB Modus13π        ! mov  al, &h13π        ! mov  ah, 0π        ! int  &h10πEND SUBππSUB Modus3π        ! mov  al, &h03π        ! mov  ah, 0π        ! int  &h10πEND SUBππSUB Linie(BYVAL x1%, BYVAL y1%, BYVAL x2%, BYVAL y2%, BYVAL Farbe%) publicπ         LOCAL s1%, s2%, s3%, s4%π         ! push esπ         ! push diπ         ! mov  ax, &ha000      ;' nur einmal VideoSegment setzenπ         ! mov  es, axπ         ! mov  ax, x2%         ;' Differenz x2% - x1% nach axπ         ! sub  ax, x1%π         ! jns  Linie1π         ! neg  ax              ; VorzeichentauschπLinie1:π         ! mov  bx, y2%         ; Differenz von y2% - y1% nach bxπ         ! sub  bx, y1%π         ! jns  Linie2π         ! neg  bx              ; VorzeichentauschπLinie2:π         ! cmp  ax, bx          ; Steigung <= 1 ?π         ! jge  Linie3A         ; Jaπ         ! jmp  Linie20         ; NeinπLinie3A:π         ! mov  cx, x1%         ; Ist x1% <= x2% ?π         ! cmp  cx, x2%π         ! jg   Linie4π         ! mov  cx, 1           ; X steigtπ         ! jmp  Linie5πLinie4:π         ! mov  cx, -1          ; X fΣlltπLinie5:π         ! mov  dx, y1%         ; ist y1% <= y2%π         ! cmp  dx, y2%π         ! jg   Linie6π         ! mov  dx, 1           ; Y steigtπ         ! jmp  Linie7πLinie6:π         ! mov  dx, -1          ; Y fΣlltπLinie7:π         ! mov  s1%, cx         ; Steigung auf dem Stack speichernπ         ! mov  s2%, dxπ         ! add  bx, bx          ; Steigung berechnenπ         ! mov  s3%, bxπ         ! sub  bx, axπ         ! mov  cx, bxπ         ! sub  cx, axπ         ! mov  s4%, cxπ         ! mov  cx, x1%π         ! mov  dx, y1%π         ! call SetPunktπLinie8:π         ! cmp  cx, x2%         ; Weitere Punkte?π         ! jz   Linie3π         ! add  cx, s1%         ; X-Koordinate erh÷henπ         ! or   bx, bx          ; Entscheiden, ob Y-Koordinate erh÷htπ         ! jns  Linie10         ; wirdπ         ! add  bx, s3%π         ! jmp  Linie11πLinie10:π         ! add  bx, s4%         ; NΣchsten Punkt ausgebenπ         ! add  dx, s2%πLinie11:π         ! call Setpunktπ         ! jmp Linie8πLinie20:ππ';----------------------------------------------------------π'; Dieser Teil wird durchlaufen, wenn die Steigung > 1 istπ';----------------------------------------------------------ππ         ! mov  cx, y1%         ; Steigung ist > 1π         ! cmp  cx, y2%         ; Ist y1% <= y2% ?π         ! jg   Linie12π         ! mov  cx,1            ; Y steigtπ         ! jmp  Linie13πLinie12:π         ! mov  cx, -1          ; Y fΣlltπLinie13:π         ! mov  dx, x1%         ; ist x1% <= x2% ?π         ! cmp  dx, x2%π         ! jg   Linie14π         ! mov  dx, 1           ; X steigtπ         ! jmp  Linie15πLinie14:π         ! mov  dx, -1          ; X fΣlltπLinie15:π         ! mov  s1%, cx         ; Steigung auf dem Stack speichernπ         ! mov  s2%, dxπ         ! add  ax, ax          ; Steigung berechnenπ         ! mov  s3%, axπ         ! sub  ax, bxπ         ! mov  cx, axπ         ! sub  cx, bxπ         ! mov  s4%, cxπ         ! mov  bx, axπ         ! mov  cx, x1%π         ! mov  dx, y1%π         ! call SetPunktπLinie16:π         ! cmp  dx, y2%         ; Weitere Punkte ausgeben?π         ! jz   Linie3π         ! add  dx, s1%π         ! or   bx, bxπ         ! jns  Linie18π         ! add  bx, s3%π         ! jmp  Linie19πLinie18:π         ! add bx, s4%π         ! add cx, s2%πLinie19:π         ! call SetPunktπ         ! jmp  Linie16πLinie3:π         ! jmp EndeπSetPunkt:π         ! mov  di, dxπ         ! push bxπ         ! mov  bx, dxπ         ! mov  ax, 320π         ! mul  bxπ         ! mov  bx, cxπ         ! add  bx, axπ         ! mov  al, Farbe%π         ! mov  es:[bx], alπ         ! pop  bxπ         ! mov  dx, diπ         ! retnπEnde:π         ! pop diπ         ! pop esπEND SUBππSUB WriteScrn (BYVAL Zeile?, BYVAL Spalte?, BYVAL Farbe%, BYVAL Text$)π        ' PowerBASIC 3.0 kompatibel, Shit Err244 Bug :-(π        LOCAL TextSeg??, TextOff??, TextLen??π        TextSeg??   = STRSEG(Text$)π        TextOff??   = STRPTR(Text$)π        TextLen??   = LEN(Text$)π        ! push bpπ        ! dec Zeile?π        ! dec Spalte?π        ! mov ax, &h1301π        ! mov bl, Farbe%π        ! mov bh, 0π        ! mov cx, TextLen??π        ! mov dh, Zeile?π        ! mov dl, Spalte?π        ! mov es, TextSeg??π        ! mov bp, TextOff??π        ! int &h10π        ! pop bpπEND SUBπ--- Cut End -------------------------------------------------------------ππDAT-file:ππ--- Cut ----------------------------------------------------------------πsection 1 of uuencode 5.20 of file raycast.dat    by R.E.M.ππbegin 644 raycast.datπM,3$Q,3$Q,3$Q,3$Q,3$Q,0T*,2`@("`@("`@("`@("`@,0T*,2`Q(#$@,2`QπM(#$@,2`Q,0T*,2`@("`@("`@("`@("`@,0T*,3$Q(#$Q,3$Q,3$Q("`@,0T*πM,2`@("`@,2`@("`Q("`@,0T*,2`@("`@,2`@("`Q("`@,0T*,3$Q,3$Q,2`@πM("`Q("`@,0T*,2`@("`@,3$Q(#$Q("`@,0T*,2`@("`@("`@("`Q("`@,0T*πM,2`@("`@("`@("`Q("`@,0T*,2`Q,3$Q,3$Q,3$Q,3$@,0T*,2`Q("`@("`@πM("`@("`@,0T*,2`Q("`@("`@(#$@("`@,0T*,2`@("`@("`@(#$@("`@,0T*πH,3$Q,3$Q,3$Q,3$Q,3$Q,0T*#0H-"@T*#0H-"@T*#0H-"@T*#0H-"@H-π`πendπsum -r/size 2742/458 section (from "begin" to "end")πsum -r/size 47403/310 entire input fileπ--- Cut End -------------------------------------------------------------πAndrew L. Ayers                BURNING TEXT                   [e-mail]           07-24-96 (00:00)       QB, QBasic, PDS        59   1675     FIREPRN.BAS ' Description : FirePrint! - Custom text print subroutine forπ'               VGA Mode 13π' Written by  : Andrew L. Ayersπ' Date        : 07/24/96π'π' This little routine allows you to place a "burning" textπ' string on the mode 13 screen. This routine was based onπ' a routine by Martin Lindhe. Both are essentially the same,π' though this one is cleaner. Remember, the better the machine,π' the better the effect. Also, smaller strings will look better.π'π' You may use this routine in any manner you like, as longπ' as you give Mr. Lindhe and myself credit in an appropriateπ' manner.π'π' I wish to thank Martin Lindhe for providing the inspirationπ' to do this routine.π'πDECLARE SUB FirePrint (h%, v%, a$, tilt%)π'πSCREEN 13π'π' Set up an all "red" paletteπ'πFOR t = 0 TO 63: PALETTE t, t: NEXT tπ'π' Call the routine once for a simple "flame" effect,π' or over and over (as done here) for a great "burning"π' effect! Use uppercase for best effect.π'πDOπ  CALL FirePrint(18, 12, "FIRE!", 0)πLOOP UNTIL INKEY$ <> ""ππSUB FirePrint (h%, v%, a$, tilt%)π  'π  ' Print the string in bright "red"π  'π  COLOR 63: LOCATE v%, h%: PRINT a$π  'π  ' Set up start and end locations for the burnπ  'π  sx% = (h% * 8) - 8: ex% = ((h% + LEN(a$)) * 8) - 8π  sy% = (v% * 8) - 16: ey% = (v% * 8) - 8π  'π  FOR y% = sy% TO ey%π    FOR x% = sx% TO ex%π      'π      ' Take the current color, subtract a random amount forπ      ' red flame "fade", and plot the new pointπ      'π      col% = POINT(x%, y%) - RND * 25: IF col% < 0 THEN col% = 0π      'π      PSET (x% + tilt%, y% - 1), col%π      'π    NEXT x%π  NEXT y%π  'πEND SUBπAndrew L. Ayers                STEEL PRINT                    [e-mail]           08-01-96 (00:00)       QB, QBasic, PDS        39   1022     STEELPRN.BAS' Description : SteelPrint! - Custom text print subroutine forπ'               VGA Mode 13π' Written by  : Andrew L. Ayersπ' Date        : 08/01/96π'π' This little routine allows you to place a "steel-like" textπ' string on the mode 13 screen.π'π' You may use this routine in any manner you like, as longπ' as you give credit in an appropriate manner.π'πDECLARE SUB SteelPrint (x%, y%, text$)π'πSCREEN 13π'πCALL SteelPrint(5, 12, "SteelPrint! by Andrew L. Ayers")π'πDO: LOOP UNTIL INKEY$ <> ""ππSUB SteelPrint (x%, y%, text$)π  'π  starty% = (y% * 8) - 4π  endy% = (y% * 8) - 9π  startx% = ((x% - 1) * 8)π  endx% = ((x% - 1) * 8) + (LEN(text$) * 8)π  colr% = 32π  'π  COLOR 15: LOCATE y%, x%: PRINT text$π  'π  FOR y1% = starty% TO endy% STEP -1π    y2% = (starty% - 1) + ((starty% - 1) - y1%)π    FOR x% = startx% TO endx%π      IF POINT(x%, y1%) THEN PSET (x%, y1%), colr%π      IF POINT(x%, y2%) THEN PSET (x%, y2%), colr%π    NEXT x%π    colr% = colr% - 2π  NEXT y1%π  'πEND SUBπAndrew L. Ayers                PSYCHO PRINT                   [e-mail]           08-13-96 (00:00)       QB, QBasic, PDS        120  3497     PSYCHO.BAS  ' Description : PsychoPrint! - Custom text print subroutine forπ'               VGA Mode 13π' Written by  : Andrew L. Ayersπ' Date        : 08/13/96π'π' What can I say? I can't seem to get enough of custom text!π' Well, anyhow - this routine needs to be played with. It allowsπ' you to create text that flashes (techno/house/rave style),π' text that fades away, dot by dot, and random snow text (certainπ' combos of which look like flowing puke), and even rainbow flashπ' text. Give it a shot!π'π' BTW: You may use this routine in any manner you like, as longπ'      as you give credit in an appropriate manner.π'πDECLARE SUB PsychoPrint (x%, y%, strg$, fclr%, bclr%, range1%, range2%, factor%, special%)π'πSCREEN 13π'πDOπ  'π  special% = 1π  'π  CALL PsychoPrint(6, 12, "PsychoPrint! by Andrew Ayers", 3, 0, 0, 15, 4, special%)π  'πLOOP UNTIL special% = 999 OR INKEY$ <> ""ππSUB PsychoPrint (x%, y%, strg$, fclr%, bclr%, range1%, range2%, factor%, special%)π  'π  STATIC FirstTime AS INTEGERπ  STATIC colr AS INTEGERπ  'π  IF strg$ = "" THEN FirstTime% = 0: EXIT SUBπ  'π  xpos% = x% * 8 - 8: ypos% = y% * 8 - 8π  xend% = xpos% + (LEN(strg$) * 8): yend% = ypos% + 8π  'π  IF FirstTime% = 0 THENπ    COLOR 255: LOCATE y%, x%: PRINT strg$: FirstTime% = 1π    COLOR 15π    colr% = fclr%π    FOR y% = ypos% TO yend%π      FOR x% = xpos% TO xend%π        IF POINT(x%, y%) <> 255 THENπ          PSET (x%, y%), bclr%π        ELSEπ          PSET (x%, y%), fclr%π        END IFπ      NEXT x%π    NEXT y%π  END IFπ  'π  '***********************************************************π  'π  flag% = 999π  'π  FOR y% = ypos% TO yend%π    FOR x% = xpos% TO xend%π      IF POINT(x%, y%) <> bclr% THENπ        flag% = 0π        PSET (x%, y%), colr%π        'π        SELECT CASE special%π          CASE 3 ' Regular Fadeπ            IF INT(RND * 2) = 1 THENπ              colr% = bclr%π            ELSEπ              colr% = fclr%π            END IFπ          CASE 4 ' Psycho Snowπ            colr% = INT(RND * factor%)π            IF colr% = bclr% THEN colr% = colr% + 1π          CASE 5 ' Psycho Snow Fadeπ            colr% = INT(RND * factor%)π        END SELECTπ        'π      END IFπ      'π      SELECT CASE special%π        CASE 1 ' Psycho Cycleπ          colr% = colr% + factor%π          IF colr% = bclr% THEN colr% = colr% + 1π          IF colr% >= range2% THEN colr% = range1%π          IF colr% = bclr% THEN colr% = colr% + 1π        CASE 2 ' Psycho Fadeπ          colr% = colr% + 1π          IF colr% > range2% THEN colr% = range1%π      END SELECTπ      'π    NEXT x%π    'π    SELECT CASE special%π      CASE 6 ' Psycho Rainbowπ        colr% = colr% + factor%π        IF colr% = bclr% THEN colr% = colr% + 1π        IF colr% >= range2% THEN colr% = range1%π        IF colr% = bclr% THEN colr% = colr% + 1π      CASE 7 ' Psycho Rainbow Fadeπ        colr% = colr% + 1π        IF colr% > range2% THEN colr% = range1%π      CASE 8 ' Regular Line Fadeπ        IF INT(RND * 2) = 1 THENπ          colr% = bclr%π        ELSEπ          colr% = fclr%π        END IFπ      CASE 9 ' Psycho Line Snowπ        colr% = INT(RND * factor%)π        IF colr% = bclr% THEN colr% = colr% + 1π      CASE 10 ' Psycho Line Snow Fadeπ        colr% = INT(RND * factor%)π    END SELECTπ    'π  NEXT y%π  'π  FOR dlay = 1 TO 10000: NEXT dlay' Adjust this to your computerπ  'π  special% = flag%π  'πEND SUBπAndrew L. Ayers                FAST VGA SCROLL                [e-mail]           08-02-96 (00:00)       QB, QBasic, PDS        88   3093     FASTSCRL.BAS' Description : FastScroll! - VGA Mode 13 Scrolling Routineπ' Written by  : Andrew L. Ayersπ' Date        : 08/02/96π'π' This little routine allows you to scroll the ENTIRE mode 13π' screen ANY number of pixels up, down, left and right. It usesπ' GET/PUT to accomplish this, but the GET/PUT is tiled aroundπ' the screen, so that the buffer used only needs to be aboutπ' 1000 bytes! When you use this routine, don't pass in bothπ' x and y offsets at one time (don't try to go diagonal) - theπ' program will bomb. Pass one, then the other to move diagonally.π' I know this isn't the best way (jumps a bit), but it does work.π' I made this routine for a game, and I only needed the fourπ' cardinal directions. When scrolling, be aware of the fact thatπ' if any graphics are on the edges of the scroll region (one pixelπ' "in" if offset is 1, two if offset is 2, 4 if offset is four,π'  etc.), when the scroll is performed, "droppings" will be leftπ' and will need to be cleaned up. I know I could have did thisπ' myself, but I felt that some people may have wanted droppingsπ' left (I don't know why...), so I left it like it is.π'π' You may use this routine in any manner you like, as longπ' as you give credit in an appropriate manner. Have phun!π'πDECLARE SUB FastScroll (XSpeed%, YSpeed%)π'πSCREEN 13π'π' Set up a Demo Graphicπ'πFOR T% = 0 TO 500π  X1% = INT(RND * 260) + 10π  Y1% = INT(RND * 140) + 10π  X2% = INT(RND * 260) + 10π  Y2% = INT(RND * 140) + 10π  C% = INT(RND * 16)π  LINE (X1%, Y1%)-(X2%, Y2%), C%πNEXT T%π'πLOCATE 11, 4: PRINT "FastScroll! by Andrew L. Ayers"π'π' Show off scrolling!π'πcount% = 0: x% = 1: y% = 0π'πDOπ  count% = count% + 1π  IF count% = 10 THEN x% = 0: y% = 1π  IF count% = 20 THEN x% = -1: y% = 0π  IF count% = 30 THEN x% = 0: y% = -1π  IF count% = 40 THEN x% = 1: y% = 0: count% = 0π  'π  CALL FastScroll(x% * 4, y% * 4)πLOOP UNTIL INKEY$ <> ""ππSUB FastScroll (XSpeed%, YSpeed%)π  'π  DIM Temp%(502)π  'π  XStep% = 40: YStep% = 25π  'π  IF XSpeed% < 0 OR YSpeed% < 0 THENπ    FOR y% = 0 TO 199 STEP YStep%π      FOR x% = 0 TO 319 STEP XStep%π        IF (XSpeed% <> 0 AND x% = 0) OR (YSpeed% <> 0 AND y% = 0) THENπ          GET (x% - XSpeed%, y% - YSpeed%)-(x% + XStep% - 1, y% + YStep% - 1), Temp%π          PUT (x%, y%), Temp%, PSETπ        ELSEπ          GET (x%, y%)-(x% + XStep% - 1, y% + YStep% - 1), Temp%π          PUT (x% + XSpeed%, y% + YSpeed%), Temp%, PSETπ        END IFπ      NEXT x%π    NEXT y%π  ELSEπ    FOR y% = 199 TO 0 STEP -YStep%π      FOR x% = 319 TO 0 STEP -XStep%π        IF (XSpeed% <> 0 AND x% = 319) OR (YSpeed% <> 0 AND y% = 199) THENπ          GET (x% - (XStep% - 1), y% - (YStep% - 1))-(x% - XSpeed%, y% - YSpeed%), Temp%π          PUT (x% - (XStep% - 1) + XSpeed%, y% - (YStep% - 1) + YSpeed%), Temp%, PSETπ        ELSEπ          GET (x% - (XStep% - 1), y% - (YStep% - 1))-(x%, y%), Temp%π          PUT (x% - (XStep% - 1) + XSpeed%, y% - (YStep% - 1) + YSpeed%), Temp%, PSETπ        END IFπ      NEXT x%π    NEXT y%π  END IFπ  'πEND SUBπAndrew L. Ayers                BIG TEXT SCROLL                [e-mail]           08-15-96 (00:00)       QB, QBasic, PDS        123  3346     BIGSCROL.BAS' Description : BigScroll! - Another VGA Mode 13 Scrolling Routineπ' Written by  : Andrew L. Ayersπ' Date        : 08/15/96π'π' This uses my FastScroll! routine, as well as another routineπ' to do a LARGE text scroller. Check it out!π'π' You may use this routine in any manner you like, as longπ' as you give credit in an appropriate manner. Have phun!π'πDECLARE SUB FastScroll (XSpeed%, YSpeed%)π'πDEFINT A-Zπ'πDIM a1(32 * 64 * 11), a2(32 * 64 * 11), a3(32 * 64 * 11)π'πSCREEN 13π'πCOLOR 7: LOCATE 10, 6: PRINT "Please wait...Building font": COLOR 0π'πFOR T = 15 TO 255: PALETTE T, 0: NEXT Tπ'πA$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ!?.-"π'πFOR T = 0 TO 30π  GOSUB DrawLetterπ  GOSUB GetLetterπNEXT Tπ'πSCREEN 0: CLS 0: SCREEN 13π'πB$ = "BIG SCROLL! BY ANDREW AYERS - HOW DO YOU LIKE IT?...      "π'πDOπ  FOR TT = 1 TO LEN(B$)π    T = INSTR(A$, MID$(B$, TT, 1)) - 1π    GOSUB PutLetterπ    FOR X = 0 TO 7π      CALL FastScroll(-8, 0)π      LINE (311, 0)-(319, 199), 0, BFπ    NEXT Xπ  NEXT TTπLOOP UNTIL UCASE$(INKEY$) = "Q"π'πSTOPπ'πDrawLetter:π  'π  LINE (0, 0)-(8, 8), 0, BFπ  LINE (0, 100)-(319, 199), 0, BFπ  'π  COLOR 255: LOCATE 1, 1: PRINT MID$(A$, T + 1, 1)π  'π  SCALE = 8π  'π  FOR y = 0 TO (SCALE - 1)π    FOR X = 1 TO 1 * SCALEπ      IF POINT(X - 1, y) = 255 THENπ        LINE (X * SCALE, 100 + y * SCALE)-(X * SCALE + SCALE, 100 + y * SCALE + SCALE), 15, BFπ      END IFπ    NEXT Xπ  NEXT yπ  'π  FOR y = 0 TO SCALE * SCALEπ    C = (16 * ABS(y < 31)) + INT(y / 2)π    FOR X = 0 TO SCALE * SCALEπ      IF POINT(X, 100 + y) THENπ        PSET (X, 100 + y), Cπ      END IFπ    NEXT Xπ  NEXT yπ  'π  RETURNππGetLetter:π  'π  IF T >= 0 AND T < 10 THEN GET (0, 100)-(64, 160), a1(T * 32 * 64)π  IF T >= 10 AND T < 20 THEN GET (0, 100)-(64, 160), a2((T - 10) * 32 * 64)π  IF T >= 20 AND T < 30 THEN GET (0, 100)-(64, 160), a3((T - 20) * 32 * 64)π  'π  RETURNππPutLetter:π  'π  IF T >= 0 AND T < 10 THEN PUT (255, 68), a1(T * 32 * 64), PSETπ  IF T >= 10 AND T < 20 THEN PUT (255, 68), a2((T - 10) * 32 * 64), PSETπ  IF T >= 20 AND T < 30 THEN PUT (255, 68), a3((T - 20) * 32 * 64), PSETπ  'π  RETURNππSUB FastScroll (XSpeed%, YSpeed%)π  'π  DIM Temp%(502)π  'π  XStep% = 40: YStep% = 25π  'π  IF XSpeed% < 0 OR YSpeed% < 0 THENπ    FOR y% = 0 TO 199 STEP YStep%π      FOR X% = 0 TO 319 STEP XStep%π        IF (XSpeed% <> 0 AND X% = 0) OR (YSpeed% <> 0 AND y% = 0) THENπ          GET (X% - XSpeed%, y% - YSpeed%)-(X% + XStep% - 1, y% + YStep% - 1), Temp%π          PUT (X%, y%), Temp%, PSETπ        ELSEπ          GET (X%, y%)-(X% + XStep% - 1, y% + YStep% - 1), Temp%π          PUT (X% + XSpeed%, y% + YSpeed%), Temp%, PSETπ        END IFπ      NEXT X%π    NEXT y%π  ELSEπ    FOR y% = 199 TO 0 STEP -YStep%π      FOR X% = 319 TO 0 STEP -XStep%π        IF (XSpeed% <> 0 AND X% = 319) OR (YSpeed% <> 0 AND y% = 199) THENπ          GET (X% - (XStep% - 1), y% - (YStep% - 1))-(X% - XSpeed%, y% - YSpeed%), Temp%π          PUT (X% - (XStep% - 1) + XSpeed%, y% - (YStep% - 1) + YSpeed%), Temp%, PSETπ        ELSEπ          GET (X% - (XStep% - 1), y% - (YStep% - 1))-(X%, y%), Temp%π          PUT (X% - (XStep% - 1) + XSpeed%, y% - (YStep% - 1) + YSpeed%), Temp%, PSETπ        END IFπ      NEXT X%π    NEXT y%π  END IFπ  'πEND SUBπAndrew L. Ayers                VGA PALETTE READ/WRITE [e-mail]           07-24-96 (00:00)       QB, QBasic, PDS        129  3662     VGAPAL.BAS  ' Description : Mode 13 VGA Palette Read/Write Subroutinesπ'               and custom palette setting routineπ' Written by  : Andrew L. Ayersπ' Date        : 07/24/96π'π' These read/write routines were developed from informationπ' provided by Eli Bennett in an ABC Code Packet. The paletteπ' setting (spreading?) routine is my own. These routines shouldπ' make it easier to read/write RGB values to the VGA palette inπ' mode 13 as well as in setting up palettes. If you use theseπ' routines, please give credit to both Mr. Bennett and myself.π' Have phun!π'πDECLARE SUB ReadRGB (red%, grn%, blu%, slot%)πDECLARE SUB WriteRGB (red%, grn%, blu%, slot%)πDECLARE SUB SetPal (start.slot%, end.slot%)π'πDIM oldr%(255), oldg%(255), oldb%(255)π'πSCREEN 13π'π' Save old paletteπ'πFOR t% = 0 TO 255π  CALL ReadRGB(oldr%(t%), oldg%(t%), oldb%(t%), t%)πNEXT t%π'π' Create a custom 256 color paletteπ'πCALL WriteRGB(63, 63, 63, 1)   ' From all whiteπCALL WriteRGB(63, 0, 0, 63)    ' to red, and thenπCALL WriteRGB(0, 63, 0, 127)   ' to green, thenπCALL WriteRGB(0, 0, 63, 191)   ' to blue, and finallyπCALL WriteRGB(63, 63, 63, 255) ' back to white...π'πCALL SetPal(1, 63)             ' Each of these linesπCALL SetPal(63, 127)           ' create a portion ofπCALL SetPal(127, 191)          ' the color spread. TheπCALL SetPal(191, 255)          ' two arguments are theπ                               ' start and ending slotsπ                               ' for the spread...π'π' Display exampleπ'πFOR t% = 1 TO 255π  LINE (t% - 1, 0)-(t% - 1, 199), t%πNEXT t%ππ'π' Rotate palette - this isn't how you would do itπ' for speed (for more speed, inline the read/write codeπ' to eliminate subroutine calling overhead), but itπ' does show how to do it. Notice the "sparklies" alongπ' the right hand edge. These are only apparent if yourπ' computer is fast enough. I believe this has to do withπ' the registers being updated faster than the video cardπ' can keep up with or sothing like that. If anyone knowsπ' how to fix this, go for it!π'πDOπ  'π  CALL ReadRGB(ored%, ogrn%, oblu%, 1)     ' Read in slot 1.π  'π  FOR t% = 1 TO 254π    CALL ReadRGB(red%, grn%, blu%, t% + 1) ' Read slots 2-255, thenπ    CALL WriteRGB(red%, grn%, blu%, t%)    ' shift to slots 1-254.π  NEXT t%π  'π  CALL WriteRGB(ored%, ogrn%, oblu%, 255)  ' Write what was in slot 1 toπ                                           ' slot 255.πLOOP UNTIL INKEY$ <> ""π'πCLSππ'π' Reset original RGB valuesπ'πFOR t% = 0 TO 255π  CALL WriteRGB(oldr%(t%), oldg%(t%), oldb%(t%), t%)πNEXT t%ππSUB ReadRGB (red%, grn%, blu%, slot%)π  'π  OUT &H3C7, slot% ' Read RGB values from slotπ  'π  red% = INP(&H3C9)π  grn% = INP(&H3C9)π  blu% = INP(&H3C9)π  'πEND SUBππSUB SetPal (start.slot%, end.slot%)π  'π  num.slots% = end.slot% - start.slot%π  'π  CALL ReadRGB(sr%, sg%, sb%, start.slot%)π  CALL ReadRGB(er%, eg%, eb%, end.slot%)π  'π  rr% = ABS(er% - sr%): rg% = ABS(eg% - sg%): rb% = ABS(eb% - sb%)π  rs% = SGN(er% - sr%): gs% = SGN(eg% - sg%): bs% = SGN(eb% - sb%)π  'π  stepr = (rr% / num.slots%) * rs%π  stepg = (rg% / num.slots%) * gs%π  stepb = (rb% / num.slots%) * bs%π  'π  r = sr%: g = sg%: b = sb%π  wr% = r: wg% = g: wb% = bπ  'π  FOR t% = start.slot% TO end.slot%π    'π    CALL WriteRGB(wr%, wg%, wb%, t%)π    'π    r = r + stepr: wr% = rπ    g = g + stepg: wg% = gπ    b = b + stepb: wb% = bπ    'π  NEXT t%π  'πEND SUBππSUB WriteRGB (red%, grn%, blu%, slot%)π  'π  OUT &H3C8, slot% ' Write RGB values to slotπ  'π  OUT &H3C9, red%π  OUT &H3C9, grn%π  OUT &H3C9, blu%π  'πEND SUBπAndrew L. Ayers                VGA SINUSOIDAL PLASMA          [e-mail]           07-24-96 (00:00)       QB, QBasic, PDS        175  4887     PLASMA.BAS  ' Description : Mode 13 VGA Sinusoidal Plasma!π' Written by  : Andrew L. Ayersπ' Date        : 07/24/96π'π' Now here's one for the masses! This creates sinusoidal plasma, whichπ' tends to be way easier to create than cloud plasma. This routine isn'tπ' optimized too much (a SIN table would speed it up some). Play with itπ' some. As always, if you use the routine in your own program or demo,π' please mention my name. Thanks, and have phun!ππDECLARE SUB SetPal (start.slot%, end.slot%)πDECLARE SUB ReadRGB (red%, grn%, blu%, slot%)πDECLARE SUB WriteRGB (red%, grn%, blu%, slot%)π'πDIM oldr%(255), oldg%(255), oldb%(255), A%(300), C%(300)π'πSCREEN 13π'π' Save old palette, set palette to black toπ' hide the build process...π'πFOR t% = 0 TO 255π  CALL ReadRGB(oldr%(t%), oldg%(t%), oldb%(t%), t%)π  CALL WriteRGB(0, 0, 0, t%)πNEXT t%π'π' TPI = 2 x PI - Do NOT mess with, needed for SIN Calcsπ' FREQ = Frequency (Duh!)   - Go ahead and mess with these two...π' AMPLITUDE = (Double Duh!)π'πTPI = 6.28318: FREQ% = 4: AMPLITUDE% = 15π'π' Create Sinusoidal Multicolored Backdrop Thingy!π'πSCALE = (TPI * FREQ%) / 320π'πFOR Y% = 0 TO 199π  RAD = 0π  COLR% = COLR% + 1: IF COLR% > 255 THEN COLR% = 1π  LINE (0, Y%)-(0, Y%), COLR%π  FOR X% = 0 TO 319 STEP 8π    YPOS% = Y% + SIN(RAD) * AMPLITUDE%π    LINE -(X%, YPOS%), COLR%π    RAD = RAD + (SCALE * 6)π  NEXT X%πNEXT Y%π'π' Warp it sinusoidally in a horizontal fashion!π'πRAD = 0πFREQ% = 8: AMPLITUDE% = 15πSCALE = (TPI * FREQ%) / 200π'πFOR Y% = 0 TO 199π  XPOS% = INT(SIN(RAD) * AMPLITUDE%)π  GET (0, Y%)-(319 - XPOS%, Y%), A%π  IF XPOS% >= 0 THENπ    GET (319 - XPOS%, Y%)-(319, Y%), C%π    PUT (XPOS%, Y%), A%, PSETπ    PUT (0, Y%), C%, PSETπ  ELSEπ    GET (ABS(XPOS%), Y%)-(319, Y%), A%π    GET (0, Y%)-(ABS(XPOS%), Y%), C%π    PUT (0, Y%), A%, PSETπ    PUT (319 + XPOS%, Y%), C%, PSETπ  END IFπ  RAD = RAD + SCALEπNEXT Y%π'π' Mask off ugly portionsπ'πLINE (0, 0)-(319, 17), 0, BFπLINE (0, 174)-(319, 199), 0, BFπLINE (0, 0)-(35, 199), 0, BFπLINE (289, 0)-(319, 199), 0, BFπ'πLOCATE 2, 9: PRINT "Sinusoidal Plasma Effect!"πLOCATE 23, 12: PRINT "By Andrew L. Ayers"π'π' Create a custom 256 color paletteπ'πCALL WriteRGB(63, 63, 63, 1)   ' From all whiteπCALL WriteRGB(63, 0, 0, 63)    ' to red, and thenπCALL WriteRGB(0, 63, 0, 127)   ' to green, thenπCALL WriteRGB(0, 0, 63, 191)   ' to blue, and finallyπCALL WriteRGB(63, 63, 63, 255) ' back to white...π'πCALL SetPal(1, 63)             ' Each of these linesπCALL SetPal(63, 127)           ' create a portion ofπCALL SetPal(127, 191)          ' the color spread. TheπCALL SetPal(191, 255)          ' two arguments are theπ                               ' start and ending slotsπ                               ' for the spread...ππ'π' Rotate palette - this isn't how you would do itπ' for speed (for more speed, inline the read/write codeπ' to eliminate subroutine calling overhead), but itπ' does show how to do it. Notice the "sparklies" alongπ' the right hand edge. These are only apparent if yourπ' computer is fast enough. I believe this has to do withπ' the registers being updated faster than the video cardπ' can keep up with or sothing like that. If anyone knowsπ' how to fix this, go for it!π'πDOπ  'π  CALL ReadRGB(ored%, ogrn%, oblu%, 1)     ' Read in slot 1.π  'π  FOR t% = 1 TO 254π    CALL ReadRGB(red%, grn%, blu%, t% + 1) ' Read slots 2-255, thenπ    CALL WriteRGB(red%, grn%, blu%, t%)    ' shift to slots 1-254.π  NEXT t%π  'π  CALL WriteRGB(ored%, ogrn%, oblu%, 255)  ' Write what was in slot 1 toπ                                           ' slot 255.πLOOP UNTIL INKEY$ <> ""π'πCLSππ'π' Reset original RGB valuesπ'πFOR t% = 0 TO 255π  CALL WriteRGB(oldr%(t%), oldg%(t%), oldb%(t%), t%)πNEXT t%ππSUB ReadRGB (red%, grn%, blu%, slot%)π  'π  OUT &H3C7, slot% ' Read RGB values from slotπ  'π  red% = INP(&H3C9)π  grn% = INP(&H3C9)π  blu% = INP(&H3C9)π  'πEND SUBππSUB SetPal (start.slot%, end.slot%)π  'π  num.slots% = end.slot% - start.slot%π  'π  CALL ReadRGB(sr%, sg%, sb%, start.slot%)π  CALL ReadRGB(er%, eg%, eb%, end.slot%)π  'π  rr% = ABS(er% - sr%): rg% = ABS(eg% - sg%): rb% = ABS(eb% - sb%)π  rs% = SGN(er% - sr%): gs% = SGN(eg% - sg%): bs% = SGN(eb% - sb%)π  'π  stepr = (rr% / num.slots%) * rs%π  stepg = (rg% / num.slots%) * gs%π  stepb = (rb% / num.slots%) * bs%π  'π  r = sr%: g = sg%: b = sb%π  wr% = r: wg% = g: wb% = bπ  'π  FOR t% = start.slot% TO end.slot%π    'π    CALL WriteRGB(wr%, wg%, wb%, t%)π    'π    r = r + stepr: wr% = rπ    g = g + stepg: wg% = gπ    b = b + stepb: wb% = bπ    'π  NEXT t%π  'πEND SUBππSUB WriteRGB (red%, grn%, blu%, slot%)π  'π  OUT &H3C8, slot% ' Write RGB values to slotπ  'π  OUT &H3C9, red%π  OUT &H3C9, grn%π  OUT &H3C9, blu%π  'πEND SUBπAndrew L. Ayers                CLOUD PLASMA EFFECT            [e-mail]           07-24-96 (00:00)       QB, QBasic, PDS        222  6227     CLOUD.BAS   ' Description : Mode 13 VGA Cloud Plasma!π' Written by  : Andrew L. Ayersπ' Date        : 07/24/96π'π' Now here's yet another for the masses! This creates cload plasma, whichπ' is also known as fractal plasma. This routine is pretty damn fastπ' already, but if you can speed it up, go for it! Play with it some.π' As always, if you use the routine in your own program or demo, pleaseπ' mention my name. Thanks, and have phun!ππDECLARE SUB SetPal (start.slot%, end.slot%)πDECLARE SUB ReadRGB (red%, grn%, blu%, slot%)πDECLARE SUB WriteRGB (red%, grn%, blu%, slot%)πDECLARE SUB PLASMA (XE%, YE%, SCALE%)πDECLARE SUB DRAW.PLASMA (XS%, YS%, XE%, YE%, REDRAW%, SCALE%)π'πDIM oldr%(255), oldg%(255), oldb%(255)π'πSCREEN 13π'π' Save old palette, change to black toπ' hide build processπ'πFOR t% = 0 TO 255π  CALL ReadRGB(oldr%(t%), oldg%(t%), oldb%(t%), t%)π  CALL WriteRGB(0, 0, 0, t%)πNEXT t%ππ'πRANDOMIZE TIMERπ'πCALL PLASMA(512, 256, 4)ππLOCATE 2, 11: PRINT "Cloud Plasma Effect!"πLOCATE 23, 12: PRINT "By Andrew L. Ayers"ππ'π' Create a custom 256 color paletteπ'πCALL WriteRGB(0, 0, 0, 1)πCALL WriteRGB(63, 63, 0, 31)πCALL WriteRGB(0, 0, 63, 63)πCALL WriteRGB(0, 63, 63, 95)πCALL WriteRGB(63, 0, 0, 127)πCALL WriteRGB(0, 63, 0, 159)πCALL WriteRGB(63, 0, 63, 191)πCALL WriteRGB(63, 63, 63, 223)πCALL WriteRGB(0, 0, 0, 255)π'πCALL SetPal(1, 31)πCALL SetPal(31, 63)πCALL SetPal(63, 95)πCALL SetPal(95, 127)πCALL SetPal(127, 159)πCALL SetPal(159, 191)πCALL SetPal(191, 223)πCALL SetPal(223, 255)ππ'π' Rotate palette - this isn't how you would do itπ' for speed (for more speed, inline the read/write codeπ' to eliminate subroutine calling overhead), but itπ' does show how to do it. Notice the "sparklies" alongπ' the right hand edge. These are only apparent if yourπ' computer is fast enough. I believe this has to do withπ' the registers being updated faster than the video cardπ' can keep up with or sothing like that. If anyone knowsπ' how to fix this, go for it!π'πDOπ  'π  CALL ReadRGB(ored%, ogrn%, oblu%, 1)     ' Read in slot 1.π  'π  FOR t% = 1 TO 254π    CALL ReadRGB(red%, grn%, blu%, t% + 1) ' Read slots 2-255, thenπ    CALL WriteRGB(red%, grn%, blu%, t%)    ' shift to slots 1-254.π  NEXT t%π  'π  CALL WriteRGB(ored%, ogrn%, oblu%, 255)  ' Write what was in slot 1 toπ                                           ' slot 255.π  FOR dlay% = 1 TO 15000: NEXT dlay%        ' This may need adjustingπLOOP UNTIL INKEY$ <> ""π'πCLSππ'π' Reset original RGB valuesπ'πFOR t% = 0 TO 255π  CALL WriteRGB(oldr%(t%), oldg%(t%), oldb%(t%), t%)πNEXT t%ππSUB DRAW.PLASMA (XS%, YS%, XE%, YE%, REDRAW%, SCALE%)π  'π  STATIC ITER%π  'π  IF REDRAW% THEN ITER% = 1: REDRAW% = 0π  IF ITER% = 1 THENπ    ITER% = 0π    LINE (XS%, YS%)-(XS% + SCALE% - 1, YS% + SCALE% - 1), INT(RND * 63) + 1, BFπ    LINE (XE%, YS%)-(XE% + SCALE% - 1, YS% + SCALE% - 1), INT(RND * 63) + 1, BFπ    LINE (XS%, YE%)-(XS% + SCALE% - 1, YE% + SCALE% - 1), INT(RND * 63) + 1, BFπ    LINE (XE%, YE%)-(XE% + SCALE% - 1, YE% + SCALE% - 1), INT(RND * 63) + 1, BFπ  END IFπ  'π  SIZE% = (XE% - XS%) / 2π  IF SIZE% < SCALE% THEN EXIT SUBπ  'π  SIZE% = SIZE% + (INT(RND * 8) - 4)π  'π  X1% = XS% + (XE% - XS%) / 2π  Y1% = YS% + (YE% - YS%) / 2π  'π  C1% = POINT(XS%, YS%)' ULπ  C2% = POINT(XE%, YS%)' URπ  C3% = POINT(XS%, YE%)' LLπ  C4% = POINT(XE%, YE%)' LRπ  'π  C5% = (C1% + C2%) / 2 ' UL+URπ  C6% = (C1% + C3%) / 2 ' UL+LLπ  C7% = (C2% + C4%) / 2 ' UR+LRπ  C8% = (C3% + C4%) / 2 ' LL+LRπ  C9% = (C5% + C6% + C7% + C8%) / 4 ' MIDπ  'π  C5% = C5% + INT(RND * SIZE%) - (SIZE% / 2)π  C6% = C6% + INT(RND * SIZE%) - (SIZE% / 2)π  C7% = C7% + INT(RND * SIZE%) - (SIZE% / 2)π  C8% = C8% + INT(RND * SIZE%) - (SIZE% / 2)π  C9% = C9% + INT(RND * SIZE%) - (SIZE% / 2)π  'π  IF C5% < 1 THEN C5% = 1π  IF C6% < 1 THEN C6% = 1π  IF C7% < 1 THEN C7% = 1π  IF C8% < 1 THEN C8% = 1π  IF C9% < 1 THEN C9% = 1π  'π  IF C5% > 63 THEN C5% = 63π  IF C6% > 63 THEN C6% = 63π  IF C7% > 63 THEN C7% = 63π  IF C8% > 63 THEN C8% = 63π  IF C9% > 63 THEN C9% = 63π  'π  IF XS% = 0 OR YS% = 0 THENπ    LINE (XS%, YS%)-(XS% + SCALE% - 1, YS% + SCALE% - 1), C5%, BF' TMπ  END IFπ  IF XS% = 0 OR Y1% = 0 THENπ    LINE (XS%, Y1%)-(XS% + SCALE% - 1, Y1% + SCALE% - 1), C6%, BF' LMπ  END IFπ  'π  IF XE% < 320 AND Y1% < 200 THENπ    LINE (XE%, Y1%)-(XE% + SCALE% - 1, Y1% + SCALE% - 1), C7%, BF' RMπ  END IFπ  IF X1% < 320 AND YE% < 200 THENπ    LINE (X1%, YE%)-(X1% + SCALE% - 1, YE% + SCALE% - 1), C8%, BF' BMπ  END IFπ  IF X1% < 320 AND Y1% < 200 THENπ    LINE (X1%, Y1%)-(X1% + SCALE% - 1, Y1% + SCALE% - 1), C9%, BF' MIDπ  END IFπ  'π  CALL DRAW.PLASMA(XS%, YS%, X1%, Y1%, REDRAW%, SCALE%)π  CALL DRAW.PLASMA(X1%, YS%, XE%, Y1%, REDRAW%, SCALE%)π  CALL DRAW.PLASMA(XS%, Y1%, X1%, YE%, REDRAW%, SCALE%)π  CALL DRAW.PLASMA(X1%, Y1%, XE%, YE%, REDRAW%, SCALE%)π  'πEND SUBππSUB PLASMA (XE%, YE%, SCALE%)π  'π  CALL DRAW.PLASMA(0, 0, XE%, YE%, 1, SCALE%)π  LINE (0, 0)-(XE% + SCALE% - 1, YS% + SCALE% - 1), 0, BFπ  LINE (0, 0)-(XS% + SCALE% - 1, YE% + SCALE% - 1), 0, BFπ  'πEND SUBππSUB ReadRGB (red%, grn%, blu%, slot%)π  'π  OUT &H3C7, slot% ' Read RGB values from slotπ  'π  red% = INP(&H3C9)π  grn% = INP(&H3C9)π  blu% = INP(&H3C9)π  'πEND SUBππSUB SetPal (start.slot%, end.slot%)π  'π  num.slots% = end.slot% - start.slot%π  'π  CALL ReadRGB(sr%, sg%, sb%, start.slot%)π  CALL ReadRGB(er%, eg%, eb%, end.slot%)π  'π  rr% = ABS(er% - sr%): rg% = ABS(eg% - sg%): rb% = ABS(eb% - sb%)π  rs% = SGN(er% - sr%): gs% = SGN(eg% - sg%): bs% = SGN(eb% - sb%)π  'π  stepr = (rr% / num.slots%) * rs%π  stepg = (rg% / num.slots%) * gs%π  stepb = (rb% / num.slots%) * bs%π  'π  r = sr%: g = sg%: b = sb%π  wr% = r: wg% = g: wb% = bπ  'π  FOR t% = start.slot% TO end.slot%π    'π    CALL WriteRGB(wr%, wg%, wb%, t%)π    'π    r = r + stepr: wr% = rπ    g = g + stepg: wg% = gπ    b = b + stepb: wb% = bπ    'π  NEXT t%π  'πEND SUBππSUB WriteRGB (red%, grn%, blu%, slot%)π  'π  OUT &H3C8, slot% ' Write RGB values to slotπ  'π  OUT &H3C9, red%π  OUT &H3C9, grn%π  OUT &H3C9, blu%π  'πEND SUBπAndrew L. Ayers                BUFFER TO SCREEN COPY ROUTINE  [e-mail]           08-21-96 (00:00)       QB, QBasic, PDS        93   4093     BCOPY.BAS   ' Description : BlastCopy! - VGA Mode 13 Buffer to Screen Copy Routineπ'               Get ready for some rock and roll - this baby's fast!π' Written by  : Andrew L. Ayersπ' Date        : 08/21/96π'π' Ok! Here's one! I am sick of Mode 13h not having a way to PCOPY! So I amπ' setting out to remedy it. First, a rather large buffer is created usingπ' DIMension. Since the smallest data type we can use is WORD size, and modeπ' 13h uses one byte per pixel, and there are 64000 pixels on the screen, weπ' need a buffer 32000 WORDs long. Hence, the following:π'πDIM buffer%(31999), code1%(29)π'π' BTW - buffer%() is the buffer, code%() is an area of memory set aside forπ'       the copy routine, see below...π'π' Now we need a copy routine. BASIC is too damn slow for this amount of work,π' so I resorted to assembler (all right, some of you! I hear groaning!).π' Noooooooo! Yes! This works, it isn't hard to understand, just get a goodπ' book! I shied away from assembler myself, but was able to pick up enough toπ' do this routine in a couple of days. So, anyhow here is the assembler code.π'π' Assembler code is as follows:π'π' 1E            PUSH    DS              ' Save the Data Segmentπ' 55            PUSH    BP              ' Save the Base Pointerπ' 89E5          MOV     BP,SP           ' Get the Stack Pointerπ' 8B460A        MOV     AX,[BP+0A]      ' Let AX=Buffer Segment Addressπ' 8ED8          MOV     DS,AX           ' Set the Data Segment=AXπ' 8B7608        MOV     SI,[BP+08]      ' Let Source Index(SI)=Buffer Offsetπ' B800A0        MOV     AX,A000         ' Set AX=Start of Video (13h)π' 8EC0          MOV     ES,AX           ' Set the Extra Segmentπ' BF0000        MOV     DI,0000         ' Set the Destination Index to 0π' B9007D        MOV     CX,7D00         ' Number of words to copy (32000)π' F3A5          REP     MOVSW           ' Move the words!π' 5D            POP     BP              ' Reset the Base Pointerπ' 1F            POP     DS              ' Reset the Data Segmentπ' CA0400        RETF    0004            ' Return to BASIC Program, clean upπ'                                         stack...π'π' I know, I know. Some of you assembler freaks out there can see some waysπ' of speeding it up, such as using LDS and LES, or even using the fasterπ' double WORD copy (on 386-486). Well, I used DEBUG, and I was learning, soπ' this is what you get. Speed it up if you want!π'π' And here it is encoded as HEX in a string for us to use...π'πcode1$ = "1E5589E58B460A8ED88B7608B800A08EC0BF0000B9007DF3A55D1FCA0400"π'π' Where did I get the HEX codes? Using DEBUG! DEBUG is what is known as aπ' monitor. It allows you to change/create machine code directly, without anπ' assembler. It isn't hard to learn. Just pick up a copy of PC Magazine'sπ' DOS books - it will show you how to use it. They also have one for BASIC,π' which shows assembler stuff. I used DEBUG instead of MASM, because of twoπ' reasons: 1) I don't have MASM, 2) MASM costs too much. Fortunately, thereπ' are shareware assemblers out there, but since DEBUG comes with DOS, whyπ' not try it?π'π' Now we poke the code into the memory reserved for it:π'πDEF SEG = VARSEG(code1%(0))π'πFOR i% = 0 TO 29π  d% = VAL("&h" + MID$(code1$, i% * 2 + 1, 2))π  POKE VARPTR(code1%(0)) + i%, d%πNEXT i%π'π' This sets the buffer to "pretty" colorsπ' Some form of assembler is needed here to speed this up - perhaps a newπ' kind of GET/PUT style routine...Hmm...π'πFOR t% = 0 TO 31999π  buffer%(t%) = t%πNEXT t%π'π' Gee... What does this line do?...π'πSCREEN 13π'π' Wait for user inputπ'πLOCATE 1, 1: PRINT "Press any key to clear...";πkey$ = INPUT$(1)π'π' Call our routine - MUST pass segment and offset of buffer using BYVAL,π' otherwise you'll get the addresses only - not good...π'πDEF SEG = VARSEG(code1%(0))πCALL ABSOLUTE(BYVAL VARSEG(buffer%(0)), BYVAL VARPTR(buffer%(0)), VARPTR(code1%(0)))πDEF SEGπ'π' As always, you may use this code for whatever you want, just give meπ' credit where you can. Thanx, and have phun!πKurt Kuzba                     USING GET & PUT                FidoNet QUIK_BAS Echo          08-02-96 (14:43)       QB, QBasic, PDS        32   1835     GET&PUT.BAS '>   Can any one help me with the statements GET adn PUT? Inπ'>   screen mode 13? Does anyone know how to display a spriteπ'>   that is made with Sprite Editor and is appended into aπ'>   QBasic program using the DATA statement? What it does isπ'>   put a sprite that you draw in Sprite Editor in QBasic usingπ'>   DATA statements?? I don't get it???π'>.....................................π'   GET and PUT in mode 13 is simple. You can actually work withπ'the data in your array, unlike with mode 12. I have yet to makeπ'heads or tails of the array data arrived at with the GET in 12.π'You require one byte for each pixel, plus four bytes to hold theπ'block format data, which is two integer values, one for the width,π'and one for the height, of the graphical block. Try this:πSCREEN 13πDIM BUF(602) AS INTEGER   '(40x30 + 4 bytes for format data) / 2πBUF(0) = 320              'set block width (in BITS!) 40 * 8πBUF(1) = 30               'set block heightπDEF SEG = VARSEG(BUF(0)): O& = VARPTR(BUF(0)) + 4π                          'set segment to directly manipulate BUFπDOπ   Colour% = RND * 255π   FOR T& = O& TO O& + 1199: POKE T&, Colour%: NEXTπ                     'set BUF contents to another color at randomπ   X% = RND * 279: Y% = RND * 169  'Pick a random screen location.π   IF (Colour% AND 1) <> 0 THEN    'This IF/THEN/ELSE is just forπ      PUT (X%, Y%), BUF, PSET      'fun, alternating between theπ   ELSE                            'absolute PSET usage and theπ      PUT (X%, Y%), BUF, XOR       'XOR, combining present imageπ   END IF                          'with the imposed image. Itπ   IF INKEY$ <> "" THEN EXIT DO    'makes the display just a bitπLOOP                               'more interesting to watchπSCREEN 0: WIDTH 80, 25: END        'go back to 80x25 text and end.πJonathan Leger                 GRAPHICS LOADER                [e-mail]             08-12-96 (21:48)       QB, QBasic, PDS        935  26247    FX2.BAS     '----------------------------------------------------------π' Requires Luke Molnar's ULTIMATE FONT V1.1π'   Please refer to GRAPHICS.ABC of the July 1996 Editionπ'----------------------------------------------------------ππDEFINT A-Zππ'**** Screen routinesπDECLARE SUB LoadGif (file$)πDECLARE SUB LoadPcx (file$)πDECLARE SUB BsaveScreen (file$)πDECLARE SUB GiftoBSAVE (gif$, bsave$, pal$)ππ'*** Palette routinesπDECLARE SUB GetPal (pal())πDECLARE SUB PutPal (pal())πDECLARE SUB SavePal (file$)πDECLARE SUB LoadPal (file$)πDECLARE SUB RotatePal (direction, pal())πDECLARE SUB CyclePal (direction, pal(), numcycles)ππ'*** Palette fxπDECLARE SUB FadeOut (pal())πDECLARE SUB FadeIn (pal())πDECLARE SUB BlackOut ()ππ'*** Drawing RoutinesπDECLARE SUB ClrScr (col)ππ'*** Font routinesπDECLARE SUB Font (Text$, XStart, Ystart, Xscale, Yscale, Style, clr)πDECLARE SUB LoadFont ()πDECLARE SUB MakeFont ()πDECLARE SUB FontPal ()ππ'*** EMS routinesπDECLARE FUNCTION NumEMSHandles% ()πDECLARE FUNCTION NumEMSPages% (Handle%)πDECLARE FUNCTION GetEMS% (numpages%)πDECLARE FUNCTION EMSPages% (func%)πDECLARE FUNCTION PageFrame% ()πDECLARE FUNCTION EMSstatus% ()πDECLARE SUB ReleaseEMS (Handle%)πDECLARE SUB MapEMS (Handle%, block%)ππ'*** Memory manipulation routinesπDECLARE SUB MemCopy (fromseg, fromoff, toseg, tooff, numbytes)πDECLARE SUB FillChar (segment, offset, value, bytes)ππ'*** MiscelaneousπDECLARE SUB WaitRetrace ()ππOPTION BASE 0ππ'$STATICπDIM pal1(0 TO 255, 3) AS INTEGERπDIM pal2(0 TO 255, 3) AS INTEGERπDIM SHARED FontBuf(0) AS STRING * 10368ππ'$DYNAMICππLoadFontππSCREEN 13ππGetPal pal1()ππFontPalπGetPal pal2()πBlackOutππFont "BASIC FX", 50, 75, 3, 3, 3, 70πFadeIn pal2()ππWHILE INKEY$ = "": WENDπFadeOut pal2()πCLSππFont "The font routines were written by:", 0, 0, 1, 1, 3, 120πFont "Luke Molnar", 70, 25, 2, 2, 3, 1πFont "Other routines written/collected by:", 0, 100, 1, 1, 3, 120πFont "Jonathan Leger", 40, 125, 2, 2, 3, 1ππFadeIn pal2()ππWHILE INKEY$ = "": WENDππFadeOut pal2()πCLSππPutPal pal1()ππFont "LoadGif()", 115, 100, 1, 1, 5, 15πFont "press a key", 105, 125, 1, 1, 5, 15πWHILE INKEY$ = "": WENDππLoadGif "letterma.gif"πFOR snd = 1000 TO 1500 STEP 100π   SOUND snd, .1π   SOUND snd + 100, .1π   SOUND snd + 200, .1πNEXT sndππWHILE INKEY$ = "": WENDππCLSπPutPal pal1()ππFont "LoadPcx()", 115, 100, 1, 1, 5, 15πFont "press a key", 105, 125, 1, 1, 5, 15πWHILE INKEY$ = "": WENDππLoadPcx "bwface.pcx"πFOR snd = 1000 TO 1500 STEP 100π   SOUND snd, .1π   SOUND snd + 100, .1π   SOUND snd + 200, .1πNEXT sndππWHILE INKEY$ = "": WENDππIF EMSstatus THENπ   IF EMSPages(1) >= 4 THENπ      PCXHandle = GetEMS(4)π      MapEMS PCXHandle, 0π      MemCopy &HA000, 0, PageFrame, 0, &HFA00π      CLSπ      Font "The previous picture has been", 0, 0, 1, 1, 5, 15π      Font "loaded into EMS memory.", 0, 25, 1, 1, 5, 15π      Font "Press any key to load picture.", 0, 50, 1, 1, 5, 15π      WHILE INKEY$ = "": WENDπ      MemCopy PageFrame, 0, &HA000, 0, &HFA00π      WHILE INKEY$ = "": WENDπ      ReleaseEMS PCXHandleπ   END IFπEND IFππGetPal pal2()ππFont "CyclePal()", 115, 100, 1, 1, 5, 15ππDO UNTIL LEN(INKEY$) > 0π   CyclePal 1, pal2(), 1πLOOPππBlackOutπCLSππFontPalπGetPal pal2()πBlackOutππFont "End of..", 0, 25, 1, 1, 5, 18πFont "BASIC FX", 50, 75, 3, 3, 3, 70πFont "...Demo", 240, 145, 1, 1, 5, 18πFadeIn pal2()ππWHILE INKEY$ = "": WENDπFadeOut pal2()πCLSπPutPal pal1()ππSCREEN 0πWIDTH 80, 25πENDππREM $STATICπSUB BlackOutππ   FOR clr = 0 TO 255π      OUT &H3C8, clrπ      OUT &H3C9, 0π      OUT &H3C9, 0π      OUT &H3C9, 0π   NEXT clrππEND SUBππSUB BsaveScreen (file$)ππDEF SEG = &HA000πBSAVE file$, 0, 64000πDEF SEGππEND SUBππSUB ClrScr (col)ππFillChar &HA000, 0, col, &HFA00ππEND SUBππSUB CyclePal (direction, pal(), numcycles)ππFOR x = 1 TO numcyclesπ   WaitRetraceπ   RotatePal direction, pal()πNEXT xππEND SUBππ'************* EMSPages%() ****************π'*** When func% is 0, returns the total ***π'*** number of 16k pages, when func% is ***π'*** 1, returns the number of available ***π'*** 16k pages.                         ***π'******************************************πFUNCTION EMSPages% (func%)ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(180)πasm$ = asm$ + CHR$(66) + CHR$(205) + CHR$(103) + CHR$(139) + CHR$(126)πasm$ = asm$ + CHR$(6) + CHR$(137) + CHR$(29) + CHR$(139) + CHR$(126)πasm$ = asm$ + CHR$(8) + CHR$(137) + CHR$(21) + CHR$(93) + CHR$(203)ππTotalPages% = 0: AvailablePages% = 0ππDEF SEG = VARSEG(asm$)π   CALL Absolute(TotalPages%, AvailablePages%, SADD(asm$))πDEF SEGππIF func% = 0 THENπ   EMSPages% = TotalPages%πELSEπ   EMSPages% = AvailablePages%πEND IFππEND FUNCTIONππ'**************** EMSstatus%() ******************π'*** Returns whether EMS is available.  -1 is ***π'*** returned if it is available, 0 otherwise ***π'************************************************πFUNCTION EMSstatus%ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(180)πasm$ = asm$ + CHR$(64) + CHR$(205) + CHR$(103) + CHR$(176) + CHR$(0)πasm$ = asm$ + CHR$(139) + CHR$(94) + CHR$(6) + CHR$(137) + CHR$(7)πasm$ = asm$ + CHR$(93) + CHR$(203)ππEMS% = -1πDEF SEG = VARSEG(asm$)π   CALL Absolute(EMS%, SADD(asm$))πDEF SEGππIF EMS% = 0 THENπ   EMSstatus = -1         'EMS installed, set to BASIC's TRUE value.πELSEπ   EMSstatus = 0          'EMS not installed, set to FALSE.πEND IFππEND FUNCTIONππSUB FadeIn (pal())ππDIM Tmp(0 TO 255, 3)ππFOR lp = 1 TO 64π   FOR clr = 0 TO 255π      FOR rgb = 1 TO 3π         IF Tmp(clr, rgb) < pal(clr, rgb) THENπ            Tmp(clr, rgb) = Tmp(clr, rgb) + 1π         END IFπ      NEXT rgbπ      OUT &H3C8, clrπ      OUT &H3C9, Tmp(clr, 1)π      OUT &H3C9, Tmp(clr, 2)π      OUT &H3C9, Tmp(clr, 3)π   NEXT clrπNEXT lpπππEND SUBππSUB FadeOut (pal())ππDIM Tmp(0 TO 255, 3)ππFOR clr = 0 TO 255π   FOR rgb = 1 TO 3π      Tmp(clr, rgb) = pal(clr, rgb)π   NEXT rgbπNEXT clrππFOR lp = 1 TO 64π   FOR clr = 0 TO 255π      FOR rgb = 1 TO 3π         IF Tmp(clr, rgb) > 0 THENπ            Tmp(clr, rgb) = Tmp(clr, rgb) - 1π         END IFπ      NEXT rgbπ      OUT &H3C8, clrπ      OUT &H3C9, Tmp(clr, 1)π      OUT &H3C9, Tmp(clr, 2)π      OUT &H3C9, Tmp(clr, 3)π   NEXT clrπNEXT lpπππEND SUBππSUB FillChar (segment, offset, value, bytes)ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(139)πasm$ = asm$ + CHR$(78) + CHR$(6) + CHR$(139) + CHR$(86) + CHR$(8)πasm$ = asm$ + CHR$(139) + CHR$(70) + CHR$(12) + CHR$(30) + CHR$(142)πasm$ = asm$ + CHR$(216) + CHR$(139) + CHR$(94) + CHR$(10) + CHR$(136)πasm$ = asm$ + CHR$(23) + CHR$(67) + CHR$(226) + CHR$(251) + CHR$(31)πasm$ = asm$ + CHR$(93) + CHR$(203)ππDEF SEG = VARSEG(asm$)π   CALL Absolute(BYVAL segment, BYVAL offset, BYVAL value, BYVAL bytes, SADD(asm$))πDEF SEGππEND SUBππSUB Font (Text$, XStart, Ystart, Xscale, Yscale, Style, clr)ππpx = XStart  ' physical x and physical yπpy = YstartππLHeight = Yscale * 8πOptimize = 63 \ LHeight ' Any constant math operations done multipe timesπ                          ' in the main loop should, well, not be doneπ                          ' in the main loop.πππ' Instead of wasting our time with all this MID$ garbage to access bytes inπ' font buffer, we'll just take a PEEK directly at them.πDEF SEG = VARSEG(FontBuf(0))ππ FOR h = 1 TO LEN(Text$)π  FPtr = 81 * (ASC(MID$(Text$, h, 1)) - 1) - 1π  FOR x = 0 TO 8π   FOR y = 0 TO 8ππ    col = PEEK(VARPTR(FontBuf(0)) + FPtr)π    FPtr = FPtr + 1π    IF col THENπ     SELECT CASE Styleπ      ' If you desire a y scale factor greater than 8, youπ      ' must change the division to higher precision...very slow.π      ' Or, you could find a way around it.π      CASE 1: PSET (px, py), Optimize * (py - Ystart) + clrπ              LINE (px, py)-(px, py + Yscale), Optimize * (py - Ystart) + clrπ      ' Notice how this style only uses 54 colors, so you can see the topπ      ' of the letters where they would normally be blackπ      CASE 2: CIRCLE (px, py), Yscale, (54 \ LHeight) * (py - Ystart) + clr + 9, , , 4π      CASE 3:  FOR sty = px TO px + Xscaleπ                FOR sty2 = py TO py + Yscaleπ                 PSET (sty, sty2), Optimize * (sty2 - Ystart) + clrπ                 IF POINT(sty - 1, sty2) = 0 THEN PSET (sty - 1, sty2), 63 + clr - 1π                 IF POINT(sty, sty2 - 1) = 0 THEN PSET (sty, sty2 - 1), 63 + clr - 1π                NEXTπ               NEXTπ       CASE 4: FOR sty = px TO px + Xscaleπ                FOR sty2 = py TO py + Yscaleπ                 PSET (sty + .4 * sty2, sty2), Optimize * (sty2 - Ystart) + clrπ                 IF POINT((sty - 1) + .4 * sty2, sty2) = 0 THEN PSET ((sty - 1) + .4 * sty2, sty2), 63 + clr - 1π                NEXTπ               NEXTπ       CASE ELSEπ            PSET (px, py), clrπ     END SELECTπ    END IFπ    py = py + Yscaleπ   NEXTπ  px = px + Xscaleπ  py = Ystartπ  NEXTπ NEXT hπDEF SEGππEND SUBππSUB FontPalπFOR x = 1 TO 63π OUT &H3C8, xπ OUT &H3C9, xπ OUT &H3C9, 0π OUT &H3C9, 0πNEXTπFOR x = 64 TO 126π OUT &H3C8, xπ OUT &H3C9, 0π OUT &H3C9, xπ OUT &H3C9, 0πNEXTπFOR x = 127 TO 189π OUT &H3C8, xπ OUT &H3C9, 0π OUT &H3C9, 0π OUT &H3C9, xπNEXTπFOR x = 190 TO 252π OUT &H3C8, xπ OUT &H3C9, xπ OUT &H3C9, 0π OUT &H3C9, xπNEXTπFOR x = 253 TO 255π OUT &H3C8, xπ OUT &H3C9, xπ OUT &H3C9, xπ OUT &H3C9, xπNEXTπEND SUBππ'********************** GetEMS%() ********************π'*** Function returns the handle value for a block ***π'*** of EMS memory that consists of numpages% 16k  ***π'*** pages.  You _must_ keep the handle value for  ***π'*** later calls that require the handle.  Example:***π'***                                               ***π'*** EmsHandle% = GetEMS%(5)                       ***π'***                                               ***π'*** EmsHandle% holds the handle info for a block  ***π'*** of memory 5 16k pages in size, oh 80k.        ***π'*****************************************************πFUNCTION GetEMS% (numpages%)ππ'pageoffset% = EMSPages%(0) - EMSPages%(1)ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(139)πasm$ = asm$ + CHR$(94) + CHR$(8) + CHR$(180) + CHR$(67) + CHR$(205)πasm$ = asm$ + CHR$(103) + CHR$(139) + CHR$(94) + CHR$(6) + CHR$(137)πasm$ = asm$ + CHR$(23) + CHR$(93) + CHR$(203)ππHandle% = 0πDEF SEG = VARSEG(asm$)π   CALL Absolute(BYVAL numpages%, Handle%, SADD(asm$))πDEF SEGππ'asm$ = ""π'asm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(139)π'asm$ = asm$ + CHR$(86) + CHR$(8) + CHR$(139) + CHR$(126) + CHR$(6)π'asm$ = asm$ + CHR$(139) + CHR$(118) + CHR$(10) + CHR$(177) + CHR$(0)π'asm$ = asm$ + CHR$(48) + CHR$(237) + CHR$(180) + CHR$(68) + CHR$(136)π'asm$ = asm$ + CHR$(200) + CHR$(137) + CHR$(243) + CHR$(205) + CHR$(103)π'asm$ = asm$ + CHR$(70) + CHR$(65) + CHR$(57) + CHR$(254) + CHR$(117)π'asm$ = asm$ + CHR$(242) + CHR$(93) + CHR$(203)π'π'DEF SEG = VARSEG(asm$)π'   CALL Absolute(BYVAL pageoffset%, BYVAL Handle%, BYVAL numpages%, SADD(asm$))π'DEF SEGππGetEMS% = Handle%ππEND FUNCTIONππSUB GetPal (pal())π   FOR clr = 0 TO 255π      OUT &H3C7, clrπ      pal(clr, 1) = INP(&H3C9)π      pal(clr, 2) = INP(&H3C9)π      pal(clr, 3) = INP(&H3C9)π   NEXT clrπEND SUBππSUB GiftoBSAVE (gif$, bsave$, pal$)ππLoadGif gif$πBsaveScreen bsave$πSavePal pal$ππEND SUBππSUB LoadFontππ   fontfile = FREEFILEππ   OPEN "basefont.dat" FOR BINARY AS #fontfileπ   GET #fontfile, , FontBuf(0)π   CLOSE #fontfileππEND SUBππSUB LoadGif (file$)πDIM byte AS STRING * 1πDIM Prefix(4095), Suffix(4095), OutStack(4095), shiftout(8)πDIM Ybase AS LONG, powersof2(11) AS LONG, WorkCode AS LONGππFOR a = 0 TO 7: shiftout(8 - a) = 2 ^ a: NEXT aπFOR a = 0 TO 11: powersof2(a) = 2 ^ a: NEXT aππgiffile = FREEFILEπOPEN file$ FOR BINARY AS #giffileπfile$ = "      ": GET #giffile, , file$πIF file$ <> "GIF87a" THEN PRINT "Not a GIF87a file.": ENDπGET #giffile, , TotalX: GET #giffile, , TotalY: GOSUB GetByteπNumColors = 2 ^ ((a AND 7) + 1): NoPalette = (a AND 128) = 0πGOSUB GetByte: Background = aπGOSUB GetByte: IF a <> 0 THEN PRINT "Bad screen descriptor.": ENDπIF NoPalette = 0 THEN P$ = SPACE$(NumColors * 3): GET #giffile, , P$πDOπ    GOSUB GetByteπ    IF a = 44 THENπ        EXIT DOπ    ELSEIF a <> 33 THENπ        PRINT "Unknown extension type.": ENDπ    END IFπ    GOSUB GetByteπ    DO: GOSUB GetByte: file$ = SPACE$(a): GET #giffile, , file$: LOOP UNTIL a = 0πLOOPπGET #giffile, , XStart: GET #giffile, , Ystart: GET #giffile, , XLength: GET #giffile, , YLengthπXEnd = XStart + XLength: YEnd = Ystart + YLength: GOSUB GetByteπIF a AND 128 THEN PRINT "Can't handle local colormaps.": ENDπInterlaced = a AND 64: PassNumber = 0: PassStep = 8πGOSUB GetByteπClearCode = 2 ^ aπEOSCode = ClearCode + 1πFirstCode = ClearCode + 2: NextCode = FirstCodeπStartCodeSize = a + 1: CodeSize = StartCodeSizeπStartMaxCode = 2 ^ (a + 1) - 1: MaxCode = StartMaxCodeππBitsIn = 0: BlockSize = 0: BlockPointer = 1πx = XStart: y = Ystart: Ybase = y * 320&ππDEF SEG = &HA000ππIF NoPalette = 0 THENπ    OUT &H3C7, 0: OUT &H3C8, 0π    FOR a = 1 TO NumColors * 3: OUT &H3C9, ASC(MID$(P$, a, 1)) \ 4: NEXT aπEND IFππLINE (0, 0)-(319, 199), Background, BFππDOπ    GOSUB GetCodeπ    IF Code <> EOSCode THENπ        IF Code = ClearCode THENπ            NextCode = FirstCodeπ            CodeSize = StartCodeSizeπ            MaxCode = StartMaxCodeπ            GOSUB GetCodeπ            CurCode = Code: LastCode = Code: LastPixel = Codeπ            IF x < 320 THEN POKE x + Ybase, LastPixelπ            x = x + 1: IF x = XEnd THEN GOSUB NextScanLineπ        ELSEπ            CurCode = Code: StackPointer = 0π            IF Code > NextCode THEN EXIT DOπ            IF Code = NextCode THENπ                CurCode = LastCodeπ                OutStack(StackPointer) = LastPixelπ                StackPointer = StackPointer + 1π            END IFππ            DO WHILE CurCode >= FirstCodeπ                OutStack(StackPointer) = Suffix(CurCode)π                StackPointer = StackPointer + 1π                CurCode = Prefix(CurCode)π            LOOPππ            LastPixel = CurCodeπ            IF x < 320 THEN POKE x + Ybase, LastPixelπ            x = x + 1: IF x = XEnd THEN GOSUB NextScanLineππ            FOR a = StackPointer - 1 TO 0 STEP -1π                IF x < 320 THEN POKE x + Ybase, OutStack(a)π                x = x + 1: IF x = XEnd THEN GOSUB NextScanLineπ            NEXT aππ            IF NextCode < 4096 THENπ                Prefix(NextCode) = LastCodeπ                Suffix(NextCode) = LastPixelπ                NextCode = NextCode + 1π                IF NextCode > MaxCode AND CodeSize < 12 THENπ                    CodeSize = CodeSize + 1π                    MaxCode = MaxCode * 2 + 1π                END IFπ            END IFπ            LastCode = Codeπ        END IFπ    END IFπLOOP UNTIL DoneFlag OR Code = EOSCodeπGOTO LeaveProcππGetByte: file$ = " ": GET #giffile, , file$: a = ASC(file$): RETURNππNextScanLine:π    IF Interlaced THENπ        y = y + PassStepπ        IF y >= YEnd THENπ            PassNumber = PassNumber + 1π            SELECT CASE PassNumberπ            CASE 1: y = 4: PassStep = 8π            CASE 2: y = 2: PassStep = 4π            CASE 3: y = 1: PassStep = 2π            END SELECTπ        END IFπ    ELSEπ        y = y + 1π    END IFπ    x = XStart: Ybase = y * 320&: DoneFlag = y > 199πRETURNπGetCode:π    IF BitsIn = 0 THEN GOSUB ReadBufferedByte: LastChar = a: BitsIn = 8π    WorkCode = LastChar \ shiftout(BitsIn)π    DO WHILE CodeSize > BitsInπ        GOSUB ReadBufferedByte: LastChar = aπ        WorkCode = WorkCode OR LastChar * powersof2(BitsIn)π        BitsIn = BitsIn + 8π    LOOPπ    BitsIn = BitsIn - CodeSizeπ    Code = WorkCode AND MaxCodeπRETURNπReadBufferedByte:π    IF BlockPointer > BlockSize THENπ        GOSUB GetByte: BlockSize = aπ        file$ = SPACE$(BlockSize): GET #giffile, , file$π        BlockPointer = 1π    END IFπ    a = ASC(MID$(file$, BlockPointer, 1)): BlockPointer = BlockPointer + 1πRETURNπLeaveProc:πCLOSEππEND SUBππSUB LoadPal (file$)ππpalfile = FREEFILEπOPEN file$ FOR BINARY AS palfileππFOR clr = 0 TO 255π   OUT &H3C8, clrπ   OUT &H3C9, ASC(INPUT$(1, palfile))π   OUT &H3C9, ASC(INPUT$(1, palfile))π   OUT &H3C9, ASC(INPUT$(1, palfile))πNEXT clrππCLOSE palfileππEND SUBππSUB LoadPcx (file$)πpcxfile = FREEFILEπOPEN file$ FOR BINARY AS pcxfileππDEF SEG = &HA000π π  SEEK #pcxfile, LOF(1) - 767π  FOR pal = 0 TO 255π     OUT &H3C8, palπ     rgb% = ASC(INPUT$(1, pcxfile))π     OUT &H3C9, rgb% / 4π     rgb% = ASC(INPUT$(1, pcxfile))π     OUT &H3C9, rgb% / 4π     rgb% = ASC(INPUT$(1, pcxfile))π     OUT &H3C9, rgb% / 4π  NEXT palπ  SEEK #pcxfile, 129π  c = 0π  WHILE c < 32000π    clr = ASC(INPUT$(1, pcxfile))π    IF clr > 192 AND clr <= 255 THENπ      LPS = clr - 192π      clr = ASC(INPUT$(1, pcxfile))π        FOR L = LPS TO 1 STEP -1π          POKE c, clrπ          c = c + 1π          LPS = LPS - 1π        NEXT Lπ    ELSEπ      POKE c, clrπ      c = c + 1π    END IFπ  WENDπ  c = 0π  DEF SEG = &HA7D0π  WHILE c < 32000π    clr = ASC(INPUT$(1, pcxfile))π    IF clr > 192 AND clr <= 255 THENπ      LPS = clr - 192π      clr = ASC(INPUT$(1, pcxfile))π         FOR L = LPS TO 1 STEP -1π          POKE c, clrπ          c = c + 1π          LPS = LPS - 1π         NEXT Lπ    ELSEπ      POKE c, clrπ      c = c + 1π    END IFπ  WENDπCLOSEπDEF SEGππEND SUBππSUB MakeFontππfontfile = FREEFILEππOPEN "basefont.dat" FOR BINARY AS #giffileπ' Hey, change 128 to 255 for the full font.πCLSπSCREEN 13πCOLOR 16πFOR ascii = 1 TO 128π CLSπ PRINT CHR$(ascii)π FOR x = 0 TO 8π  FOR y = 0 TO 8π   pnt$ = CHR$(POINT(x, y))π   PUT #giffile, , pnt$π   pnt$ = ""π  NEXTπ NEXTπNEXTπCLOSEπOPEN "basefont.dat" FOR BINARY AS #giffileπ GET #giffile, , FontBuf(0)πCLOSE #giffileπEND SUBππ'***************** MapEMS () ***********************************π'*** Sets the page of a memory block (identified by Handle%) ***π'*** that is located at the beginning of the page frame.     ***π'*** Example:                                                ***π'***                                                         ***π'*** EmsHandle% = GetEMS%(8)                                 ***π'*** MapEMS EmsHandle%, 4                                    ***π'***                                                         ***π'*** When the page frame segment is next written to, the info***π'*** will be placed starting at the 4th page in the block of ***π'*** memory represented by EmsHandle%.  This could be use,   ***π'*** for instance, to store multiple SCREEN 13 images in one ***π'*** EMS block, by moving the first 64k image into the first ***π'*** 4 16k pages (16000 * 4 = 64000) by using:               ***π'***                                                         ***π'*** MapEMS EmsHandle%, 0                                    ***π'***                                                         ***π'*** And then putting the next 64k image into the next 4 EMS ***π'*** pages by using:                                         ***π'***                                                         ***π'*** MapEMS EmsHandle%, 4                                    ***π'***                                                         ***π'*** ... and then moving the image into the memory block.    ***π'***************************************************************πSUB MapEMS (Handle%, pageoffset%)ππnumpages% = 4ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(139)πasm$ = asm$ + CHR$(86) + CHR$(8) + CHR$(139) + CHR$(126) + CHR$(6)πasm$ = asm$ + CHR$(139) + CHR$(118) + CHR$(10) + CHR$(177) + CHR$(0)πasm$ = asm$ + CHR$(48) + CHR$(237) + CHR$(180) + CHR$(68) + CHR$(136)πasm$ = asm$ + CHR$(200) + CHR$(137) + CHR$(243) + CHR$(205) + CHR$(103)πasm$ = asm$ + CHR$(70) + CHR$(65) + CHR$(57) + CHR$(249) + CHR$(117)πasm$ = asm$ + CHR$(242) + CHR$(93) + CHR$(203)ππDEF SEG = VARSEG(asm$)π   CALL Absolute(BYVAL pageoffset%, BYVAL Handle%, BYVAL numpages%, SADD(asm$))πDEF SEGππEND SUBππSUB MemCopy (fromseg, fromoff, toseg, tooff, bytes)ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(30)πasm$ = asm$ + CHR$(139) + CHR$(70) + CHR$(10) + CHR$(142) + CHR$(192)πasm$ = asm$ + CHR$(139) + CHR$(70) + CHR$(14) + CHR$(142) + CHR$(216)πasm$ = asm$ + CHR$(139) + CHR$(118) + CHR$(8) + CHR$(139) + CHR$(126)πasm$ = asm$ + CHR$(12) + CHR$(139) + CHR$(78) + CHR$(6) + CHR$(243)πasm$ = asm$ + CHR$(164) + CHR$(31) + CHR$(93) + CHR$(203)ππDEF SEG = VARSEG(asm$)π   CALL Absolute(BYVAL fromseg, BYVAL fromoff, BYVAL toseg, BYVAL tooff, BYVAL bytes, SADD(asm$))πDEF SEGππEND SUBππ'****************************** NumEMSHandles%() *********************π'*** Returns the number of EMS handles presently being used (there ***π'*** are a maximum of 256 handles possible at any given time).     ***π'*********************************************************************πFUNCTION NumEMSHandles%ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(180)πasm$ = asm$ + CHR$(75) + CHR$(205) + CHR$(103) + CHR$(139) + CHR$(126)πasm$ = asm$ + CHR$(6) + CHR$(137) + CHR$(29) + CHR$(93) + CHR$(203)ππNumHandles% = 0πDEF SEG = VARSEG(asm$)π   CALL Absolute(NumHandles%, SADD(asm$))πDEF SEGππNumEMSHandles% = NumHandles%ππEND FUNCTIONππ'***************************** NumEMSPages%() *************************π'*** Returns the number of 16k pages being used by the memory block ***π'*** that is represented by Handle%.                                ***π'**********************************************************************πFUNCTION NumEMSPages% (Handle%)ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(139)πasm$ = asm$ + CHR$(86) + CHR$(6) + CHR$(180) + CHR$(76) + CHR$(205)πasm$ = asm$ + CHR$(103) + CHR$(139) + CHR$(126) + CHR$(8) + CHR$(137)πasm$ = asm$ + CHR$(29) + CHR$(93) + CHR$(203)ππDEF SEG = VARSEG(asm$)π   CALL Absolute(numpages%, Handle%, SADD(asm$))πDEF SEGππNumEMSPages% = numpages%ππEND FUNCTIONππ'******************************* PageFrame% ***************************π'*** Returns the segment that you will need to write to in order to ***π'*** store your data into EMS memory.  For example, PageFrame% may  ***π'*** return D000 (HEX, -12288 decimal), and then you might do this: ***π'***                                                                ***π'*** DEF SEG = PageFrame%        'D000                              ***π'*** MyData$ = "This is a block of data I want to store in EMS."    ***π'*** FOR X = 1 TO LEN(MyData$)                                      ***π'***   POKE X, ASC(MID$(MyData$, X, 1))                             ***π'*** NEXT X                                                         ***π'*** DEF SEG                                                        ***π'***                                                                ***π'*** Note, though, that you have to have a block of EMS opened with ***π'*** GetEMS%() and maped with MapEMS before you can write to the    ***π'*** block.                                                         ***π'**********************************************************************πFUNCTION PageFrame%ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(180)πasm$ = asm$ + CHR$(65) + CHR$(205) + CHR$(103) + CHR$(139) + CHR$(126)πasm$ = asm$ + CHR$(6) + CHR$(137) + CHR$(29) + CHR$(93) + CHR$(203)ππPageFrameAddr% = 0πDEF SEG = VARSEG(asm$)π   CALL Absolute(PageFrameAddr%, SADD(asm$))πDEF SEGππPageFrame% = PageFrameAddr%ππEND FUNCTIONππSUB PutPal (pal())π  π   FOR clr = 0 TO 255π      OUT &H3C8, clrπ      OUT &H3C9, pal(clr, 1)π      OUT &H3C9, pal(clr, 2)π      OUT &H3C9, pal(clr, 3)π   NEXT clrππEND SUBππ'****************************** ReleaseEMS() **************************π'*** Releases the EMS memory associated with Handle%.  This is very ***π'*** important to do before you exit your program, otherwise the    ***π'*** memory being used by your open handles will not be available   ***π'*** again until you reboot.                                        ***π'**********************************************************************πSUB ReleaseEMS (Handle%)ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(180)πasm$ = asm$ + CHR$(69) + CHR$(139) + CHR$(86) + CHR$(6) + CHR$(205)πasm$ = asm$ + CHR$(103) + CHR$(93) + CHR$(203)ππDEF SEG = VARSEG(asm$)π   CALL Absolute(BYVAL Handle%, SADD(asm$))πDEF SEGππEND SUBππSUB RotatePal (direction, pal())ππ   SELECT CASE directionπ         CASE 1π            temp1 = pal(255, 1)π            temp2 = pal(255, 2)π            temp3 = pal(255, 3)π            FOR rgb = 1 TO 3π               FOR col = 254 TO 0 STEP -1π                  pal(col + 1, rgb) = pal(col, rgb)π               NEXT colπ            NEXT rgbπ            pal(0, 1) = temp1π            pal(0, 2) = temp2π            pal(0, 3) = temp3π         CASE -1π            temp1 = pal(0, 1)π            temp2 = pal(0, 2)π            temp3 = pal(0, 3)π            FOR rgb = 1 TO 3π               FOR col = 0 TO 254π                  pal(col, rgb) = pal(col + 1, rgb)π               NEXT colπ            NEXT rgbπ            pal(255, 1) = temp1π            pal(255, 2) = temp2π            pal(255, 3) = temp3π   END SELECTππ   PutPal pal()ππEND SUBππSUB SavePal (file$)ππ   palfile = FREEFILEπ   OPEN file$ FOR OUTPUT AS palfileππ   FOR clr = 0 TO 255π      OUT &H3C7, clrπ      PRINT #palfile, CHR$(INP(&H3C9));π      PRINT #palfile, CHR$(INP(&H3C9));π      PRINT #palfile, CHR$(INP(&H3C9));π   NEXT clrππ   CLOSE palfileππEND SUBππSUB SetPal (pal())πEND SUBππSUB WaitRetraceπ   WAIT &H3DA, 8πEND SUBπBrent P. Newhall               2D POLYGON ENGINE              comp.lang.basic.misc           08-22-96 (11:30)       QB, QBasic, PDS        223  5653     2DPOLY.BAS  'This is a C-to-BASIC conversion from Andre LaMothe's book "Teachπ'Yourself Game Programming in 21 Days".  It's a simple demo with threeπ'asteroids twirling on the screen and a scrolling starfield in theπ'background.ππ'If you have need, take it and use it.  There are enough SUBs to do mostπ'of what you should need to do.ππ' Polygonπ' by Brent P. Newhall ([e-mail])ππDEFINT A-ZππCONST FALSE = 0, TRUE = NOT FALSEπCONST MAX.VERTICES = 15πCONST MAX.STARS = 30ππTYPE VertexTypeπ  x AS SINGLEπ  y AS SINGLEπEND TYPEπTYPE PolygonTypeπ  border AS INTEGER    ' Border colorπ  interior AS INTEGER  ' Interior colorπ  closed AS INTEGER    ' Is the polygon closed?π  filled AS INTEGER    ' Is the polygon filled?π  lxo AS INTEGER       ' Local X originπ  lyo AS INTEGER       ' Local Y originπ  NumVertices AS INTEGERπEND TYPEπTYPE StarTypeπ  x AS INTEGERπ  y AS INTEGERπ  dist AS INTEGERπEND TYPEππDECLARE SUB CreateTables ()πDECLARE SUB DrawPolygon (poly AS PolygonType, polyvert() AS VertexType)πDECLARE SUB ErasePolygon (poly AS PolygonType, polyvert() AS VertexType)πDECLARE SUB MovePolygon (poly AS PolygonType, dx AS INTEGER, dy AS INTEGER)πDECLARE SUB ScalePolygon (poly AS PolygonType, polyvert() AS VertexType, scale AS SINGLE)πDECLARE SUB RotatePolygon (poly AS PolygonType, polyvert() AS VertexType, angle AS INTEGER)πDECLARE SUB StarField ()ππDIM ast1 AS PolygonType ' Create basic asteroidsπDIM ast2 AS PolygonTypeπDIM ast3 AS PolygonTypeπast1.NumVertices = 5πast2.NumVertices = 5πast3.NumVertices = 5πREDIM astvert1(1 TO ast1.NumVertices) AS VertexType ' Create verticesπREDIM astvert2(1 TO ast2.NumVertices) AS VertexTypeπREDIM astvert3(1 TO ast3.NumVertices) AS VertexTypeπDIM SHARED star(1 TO MAX.STARS) AS StarTypeπDIM SHARED SinLook(0 TO 361) AS DOUBLE, CosLook(0 TO 361) AS DOUBLEπDIM SHARED c(1 TO 3) ' Colorπc(1) = 15: c(2) = 7: c(3) = 8ππFOR cnt = 1 TO MAX.STARS ' Define all the starsπ  star(cnt).x = INT(RND * 320) ' Create random positionπ  star(cnt).y = INT(RND * 200)π  star(cnt).dist = INT(RND * 3 + 1)πNEXT cntππast1.border = 8πast1.interior = 8πast1.closed = TRUEπast1.filled = FALSEπast1.lxo = 110πast1.lyo = 100πFOR cnt1 = 1 TO ast1.NumVerticesπ  READ astvert1(cnt1).x, astvert1(cnt1).yπNEXT cnt1πast2.border = 8πast2.interior = 8πast2.closed = TRUEπast2.filled = FALSEπast2.lxo = 160πast2.lyo = 80πFOR cnt1 = 1 TO ast2.NumVerticesπ  READ astvert2(cnt1).x, astvert2(cnt1).yπNEXT cnt1πast3.border = 8πast3.interior = 8πast3.closed = TRUEπast3.filled = FALSEπast3.lxo = 210πast3.lyo = 100πFOR cnt1 = 1 TO ast3.NumVerticesπ  READ astvert3(cnt1).x, astvert3(cnt1).yπNEXT cnt1ππPRINT "Creating tables...."πCreateTablesπSCREEN 7ππDOπ  StarFieldπ  RotatePolygon ast1, astvert1(), 5π  RotatePolygon ast2, astvert2(), 8π  RotatePolygon ast3, astvert3(), -4π  DrawPolygon ast1, astvert1()π  DrawPolygon ast2, astvert2()π  DrawPolygon ast3, astvert3()π  t! = TIMER: WHILE t! = TIMER: WEND ' Pauseπ  ErasePolygon ast1, astvert1()π  ErasePolygon ast2, astvert2()π  ErasePolygon ast3, astvert3()π  IF INKEY$ <> "" THEN quit = 1πLOOP UNTIL quit > 0πENDππ' Asteroid 1 verticesπDATA   0,-15πDATA  20, 5πDATA   5, 7πDATA  -1, 10πDATA  -4, 1ππ' Asteroid 2 verticesπDATA   0,-15πDATA  20,-9πDATA  10, 7πDATA  -1, 10πDATA  -4, 1ππ' Asteroid 3 verticesπDATA   0,-15πDATA  10,-2πDATA   5, 7πDATA  -1, 10πDATA  -9, 1ππDEFSNG A-ZπSUB CreateTablesππFOR cnt = 0 TO 360π  CosLook(cnt) = COS(cnt * 3.14159 / 180)π  SinLook(cnt) = SIN(cnt * 3.14159 / 180)πNEXT cntππEND SUBππSUB DrawPolygon (poly AS PolygonType, polyvert() AS VertexType)ππxo = poly.lxoπyo = poly.lyoππFOR cnt = 1 TO poly.NumVertices - 1π  LINE (xo + polyvert(cnt).x, yo + polyvert(cnt).y)-(xo + polyvert(cnt + 1).x, yo + polyvert(cnt + 1).y), poly.borderπNEXT cntππIF poly.closed THENπ  LINE (xo + polyvert(poly.NumVertices).x, yo + polyvert(poly.NumVertices).y)-(xo + polyvert(1).x, yo + polyvert(1).y), poly.borderπEND IFππEND SUBππSUB ErasePolygon (poly AS PolygonType, polyvert() AS VertexType)ππxo = poly.lxoπyo = poly.lyoππFOR cnt = 1 TO poly.NumVertices - 1π  LINE (xo + polyvert(cnt).x, yo + polyvert(cnt).y)-(xo + polyvert(cnt + 1).x, yo + polyvert(cnt + 1).y), 0πNEXT cntππIF poly.closed THENπ  LINE (xo + polyvert(poly.NumVertices).x, yo + polyvert(poly.NumVertices).y)-(xo + polyvert(1).x, yo + polyvert(1).y), 0πEND IFππEND SUBππSUB MovePolygon (poly AS PolygonType, dx AS INTEGER, dy AS INTEGER)ππpoly.lxo = poly.lxo + dxπpoly.lyo = poly.lyo + dyππEND SUBππSUB RotatePolygon (poly AS PolygonType, polyvert() AS VertexType, angle AS INTEGER)ππIF angle >= 0 THENπ  si = SinLook(angle)π  cs = CosLook(angle)πELSEπ  si = SinLook(angle + 360)π  cs = CosLook(angle + 360)πEND IFππFOR cnt = 1 TO poly.NumVerticesπ  rx = polyvert(cnt).x * cs - polyvert(cnt).y * siπ  ry = polyvert(cnt).y * cs + polyvert(cnt).x * siπ  polyvert(cnt).x = rxπ  polyvert(cnt).y = ryπNEXT cntππEND SUBππSUB ScalePolygon (poly AS PolygonType, polyvert() AS VertexType, scale AS SINGLE)ππFOR cnt = 1 TO poly.NumVerticesπ  polyvert(cnt).x = polyvert(cnt).x * scaleπ  polyvert(cnt).y = polyvert(cnt).y * scaleπNEXT cntππEND SUBππDEFINT A-ZπSUB StarFieldππFOR cnt = 1 TO MAX.STARSπ  PSET (star(cnt).x, star(cnt).y), 0π  star(cnt).y = star(cnt).y + (4 - star(cnt).dist)π  IF star(cnt).y > 199 THENπ    star(cnt).x = INT(RND * 320)π    star(cnt).y = INT(RND * 200)π    star(cnt).dist = INT(RND * 3 + 1)π  END IFπ  PSET (star(cnt).x, star(cnt).y), c(star(cnt).dist)πNEXT cntππEND SUBπKurt Eckhardt                  VARIABLE PLASMA EFFECT         [e-mail]                08-24-96 (00:00)       QB, QBasic, PDS        197  6164     PLASMA.BAS  DECLARE SUB Info ()πDECLARE SUB RotatePalette (k$)πDECLARE SUB RunX ()πDECLARE SUB RunY ()πDECLARE SUB SetPts ()πDECLARE SUB SetPalette ()π'Coded and designed by Kurt Eckhardt on 08/22/96π'Copyrite 1996 by Kurt Eckhardtπ'Fastened by Steven de Brouwer <[e-mail]> on 08/24/96π'π'This program sets up a grid of four points (the corners) and generatesπ'a faded verticle line between them. It then does this horizontallyπ'to create of sort of plasma effect.π'The effect works best when there is a diversity of colors on both sidesπ'of the screen. This way the colors don't just fade, but rather scroll.π'You'll see...π'πDEFINT A-ZπDIM SHARED pal(192, 3)πCLS : CLEARπRANDOMIZE TIMERπCALL InfoππSCREEN 13πPRINT "Loading Palette...": SetPaletteπCLSπDOπ   CALL SetPtsπ   CALL RunYπ   CALL RunXπ   DOπ      CALL RotatePalette(k$)π   LOOP UNTIL k$ <> ""πLOOP UNTIL k$ = CHR$(27)ππSUB InfoπCLSπPRINT SPACE$(30); "Information": PRINTπPRINT "Coded and Designed by Kurt Eckhardt"πPRINT "Copyrite 1996   All Rights Reserved"πPRINT "V2.0    Completed on 8/22/96"πPRINT "V2.0.0a Improved  on 8/24/96"πPRINT "        by Steven <[e-mail]> de Brouwer"πPRINTπPRINT "This program works best when there is a diversity of colors on both"πPRINT "sides of the screen. This creates a nicer pattern on the screen"πPRINT "with more colors, so the scrolling effect will be much nicer."πPRINT "Also experiment with pressing Other Keys! It's fun..."πPRINTπPRINT "                               Enjoy!"πPRINT : PRINTπPRINT "Escape    : Exit Program"πPRINT "SpaceBar  : Change Direction"πPRINT "Other Keys: Change Pattern/ Pallette"πDO: LOOP UNTIL INKEY$ <> "": CLSπPRINT SPACE$(30); "Help the student": PRINTπPRINT "If this program brings a smile to your face, or you find any techniques"πPRINT "helpful in you own programming endevours, I would greatly appreciate you"πPRINT "sending me 1$ so I can make my way through college. Right now I am struggling"πPRINT "as I have no money!"πPRINT "I bet you can look around right now and find one buck within 10 feet"πPRINT "of yourself- if not, you are as broke as I am."πPRINT "Any comments or questions, send me some email at <[e-mail]>"πPRINT "Here's the address for that measly buck: "πPRINTπPRINT "Kurt Eckhardt"πPRINT "1820 West Oak Knoll Circle"πPRINT "Ft. Lauderdale FL 33324"πPRINTπPRINT "Thanks!"πDO: LOOP WHILE INKEY$ = ""πCLSπPRINT SPACE$(35); "Legal Stuff"πPRINTπPRINT "1. This program may be freely distributed so long as no changes have been made."πPRINT "2. This program, or any part of it, may not be used in another program"πPRINT "   without my written consent."πPRINT "3. I, Kurt Eckhardt, retain all rights to this code and retain the power"πPRINT "   to invoke them at anytime I see fit."πPRINT "4. I take no responsibilty for any adverse affects that may be caused by"πPRINT "   usage of this program upon your machine."πPRINT "5. Acknowledge your pleasure by e-mail to [e-mail]"πPRINT "   (He loves e-mail!)"πLOCATE 15, 13πPRINT "By possessing this program you agree with these terms."πDO: LOOP WHILE INKEY$ = ""ππEND SUBππSUB RotatePalette (n$)π   'π   STATIC cngdiv, cng         'Keep values of these two between callsπ   IF cngdiv = 0 THEN cngdiv = 1 - INT(RND * 2) * 2 'Random directionπ   cng = cng - cngdivπ   IF cng < 1 THEN cng = 192π   IF cng > 192 THEN cng = 1π   s = (1 - SGN(cngdiv)) / 2  's=0 or s=1π   'π   IF cng <> 1 + s * 191 THENπ      FOR lp = 1 TO 3π         pal(cng, lp) = pal(cng - cngdiv, lp)π      NEXT lpπ   ELSEπ      FOR lp = 1 TO 3π         pal(1 + s * 191, lp) = pal(192 - s * 191, lp)π      NEXT lpπ   END IFπ   'π   OUT &H3C8, cng                  'Write Palette Registerπ   OUT &H3C9, pal(cng, 1)          'Write Palette Data(RGB)π   OUT &H3C9, pal(cng, 2)π   OUT &H3C9, pal(cng, 3)π   'π   n$ = INKEY$π   IF n$ = " " THEN n$ = "": cngdiv = -cngdiv 'Change directionπ   'πEND SUBππSUB RunXπ   π   r = INT(RND * 10)                   ' These two lines plus 'STEP 10'π   FOR x = 0 TO 9                      ' For the luxaflex-effectπ      FOR yy = 0 TO 199 STEP 10π         y = yy + (x + r) MOD 10                'This one too :)π         ch = POINT(319, y): cl = POINT(0, y)π         cdiv! = (ch - cl) / 319π         FOR i = 1 TO 318π            PSET (i, y), cl + INT(i * cdiv!)    'Interpolate colorπ            'π            CALL RotatePalette(k$)     'these three linesπ            IF k$ = CHR$(27) THEN END  'for effects during redrawπ            IF k$ <> "" THEN stp = 1π            'π         NEXT iπ         IF stp = 1 THEN LINE (0, 0)-(319, 199), 0, B: EXIT SUBπ      NEXT yyπ   NEXT xπ   LINE (0, 0)-(319, 199), 0, Bπ   πEND SUBππSUB RunYπ   π   FOR i = 0 TO 1π      ch = POINT(i * 319, 199): cl = POINT(i * 319, 0)π      FOR j = 1 TO 198π         PSET (i * 319, j), cl + INT((j / 199) * (ch - cl))π      NEXT jπ   NEXT iπ   πEND SUBππSUB SetPaletteπ  π   RA = 1: GA = 0: BA = 0: Rval = 63π   FOR cnt = 1 TO 192π      Rval = Rval + RAπ      Gval = Gval + GAπ      Bval = Bval + BAπ      π      IF Rval > 62 AND Gval <> 63 AND Bval = 0 THEN GA = 2π      IF Gval > 62 AND Bval <> 63 AND Rval = 0 THEN BA = 2π      IF Bval > 62 AND Rval <> 63 AND Gval = 0 THEN RA = 2π      π      IF Gval > 62 AND Rval > 62 THEN RA = -2π      IF Rval < 0 AND Gval > 62 THEN BA = 2π      IF Gval > 62 AND Bval > 62 THEN GA = -2π      IF Gval < 0 AND Bval > 62 THEN RA = 2π      IF Rval > 62 AND Bval > 62 THEN BA = -2π      IF Bval < 0 AND Rval > 62 THEN GA = 2π      π      IF Rval > 62 THEN Rval = 63π      IF Rval < 0 THEN Rval = 0π      IF Gval > 62 THEN Gval = 63π      IF Gval < 0 THEN Gval = 0π      IF Bval > 62 THEN Bval = 63π      IF Bval < 0 THEN Bval = 0π      pal(cnt, 1) = Rvalπ      pal(cnt, 2) = Gvalπ      pal(cnt, 3) = Bvalπ      OUT &H3C8, cntπ      OUT &H3C9, Rvalπ      OUT &H3C9, Gvalπ      OUT &H3C9, Bvalπ   NEXT cntπ   πEND SUBππSUB SetPtsπ   π   FOR x = 0 TO 1π      PSET (x * 319, 0), (RND * 191) + 2π      PSET (x * 319, 199), (RND * 191) + 2π   NEXT xπ   πEND SUBππErika Schulze                  TGA VIEWER                     [e-mail]     08-29-96 (18:39)       QB, QBasic, PDS        243  10390    TGA.BAS     '***************************************************************************π'Program:       TGA.BAS                                                    *π'Task:          TGA viewer for SCREEN 13 - uncompressed TGA files.         *π'               Version 1.0                                                *π'Language:      QBASIC mixed with machine code.                            *π'Author:        Erika Schulze                                              *π'               CIS: 100775,2275                                           *π'               Internet: [e-mail]                       *π'               Free for use.                                              *π'               Use it, abuse it, but don't blame me!                      *π'Note:          It seems to me that the main problem is reading the data   *π'               from the disk; that's to slow. If somebody has a better    *π'               solution for this - your assistance is welcome. Please     *π'               send me a message with your suggestions for improvements.  *π'***************************************************************************ππ'The  TGA  (True Version Targa) isn't complicated. There is only aπ'TGA header of 18 bytes with all informations about the image.π'Structure of the TGA header:ππ'Offset   Length   Descriptionπ'======   ======   ===========ππ'00H      BYTE     info:π'                  It's  possible,  that after the 18 bytes of theπ'                  header, the file contains an information block.π'                  This  block, for  example, holds  the copyrightπ'                  information.  The  byte  info  stands  for  theπ'                  length of the information block.π'01H      BYTE     colortyp:π'                  0 ===> RGB imageπ'                  1 ===> image has a DAC tableπ'02H      BYTE     imagetyp:π'                  This  byte contains information about the imageπ'                  typ:π'                  1 ===> uncompressed  image  datas  with  a  DACπ'                  tableπ'                  2 ===> uncompressed RGB fileπ'                  9 ===> runlength encoded datas with a DAC tableπ'                 10 ===> runlength encoded RGB fileπ'03H      WORD     origin:π'                  This word contains the index of the first entryπ'                  in the DAC table (mostly 0).π'05H      WORD     colnumber:π'                  This  word contains the number of colors in theπ'                  DAC  table.  That's  not  the length of the DACπ'                  table in byte!π'07H      BYTE     entrybits:π'                  Size of on entry in the DAC table. An entry hasπ'                  16, 24 or 32 bits.π'08H      WORD     xvalue:π'                  The  x-value  of  the lower left corner of theπ'                  TGA image (mostly 0).π'0AH      WORD     yvalue:π'                  The  y-value  of  the lower left corner of theπ'                  TGA image (mostly 0).π'0CH      WORD     widt:π'                  The image width in pixels.π'0EH      WORD     height:π'                  The image height in pixels.π'10H      BYTE     pixelsize:π'                  Number of bits per pixel.π'                  DAC images ===> valid values are 8 and 16π'                  RGB images ===> valid values are 16, 24 and 32π'11H      BYTE     descriptor:π'                  The   image   descriptor   contains  additionalπ'                  informations.ππ'The structure of the image descriptor:ππ'Bit 0 - 3: fill bitsπ'Bit 4    : always 0π'Bit 5    : 0  ===> image origin in the lower left cornerπ'           1  ===> image origin in the upper left cornerπ'Bit 6 - 7: 00 ===> the image rows are stored one after the otherπ'           01 ===> first are stored the even rows (0, 2, 4 ...)π'                   after  this  are  stored the odd rows (1, 3, 5 ...)ππ'The formula to calculate the length of the DAC table:ππ'daclength% = colnumber*entrybits/8ππ'After the  18 bytes of the TGA header is  stored  the informationπ'block  in the TGA file, but the length of this block is mostly 0.π'After  the information block is stored the DAC table and then theπ'image datas.ππ'===========================================================================π'Program starts here.                                                      =π'===========================================================================ππDECLARE SUB Reading (x%, y%)πDECLARE SUB Waiting ()πTYPE tgaheader                  'declare the headerπ  info       AS STRING * 1      'length of image information blockπ  colortyp   AS STRING * 1      'DAC table or BGR formatπ  imagetyp   AS STRING * 1      'compressed or uncompressedπ  origin     AS INTEGER         'first entry in the DAC tableπ  colnumber  AS INTEGER         'number of colors in the DAC tableπ  entrybits  AS STRING * 1      'entry size in the DAC tableπ  xvalue     AS INTEGER         'x co-ordinate lower left cornerπ  yvalue     AS INTEGER         'y co-ordinate lower left cornerπ  widt       AS INTEGER         'image widthπ  height     AS INTEGER         'image heightπ  pixelsize  AS STRING * 1      'number of bits per pixelπ  descriptor AS STRING * 1      'image descriptorπEND TYPEπDIM header AS tgaheader         'define the headerπDIM set%(42)                    'machine code array for pixel set procedureπsetseg% = VARSEG(set%(0))πsetoff% = VARPTR(set%(0))       'start address for pixel set routineπDIM text%(4)                    'machine code array for text mode procedureπtextseg% = VARSEG(text%(0))πtextoff% = VARPTR(text%(0))     'start address text mode procedureπfile$ = "ELENA.TGA"             'change it, if necessaryπfilelength& = 0                 'length of the TGA fileπdaclength% = 0                  'length of the DAC tableπnumcolors% = 0                  'number of used colorsπdacstart& = 0                   'start of the DAC values in theπ                'TGA fileπdacend& = 0                     'end of the DAC valuesπimstart& = 0                    'start of the image data in theπ                'TGA fileπCLSπRESTORE setpixelπCALL Reading(setseg%, setoff%)  'read the machine code (pixel procedure)πRESTORE textmodeπCALL Reading(textseg%, textoff%)'read the machine code (text mode routine)πOPEN file$ FOR BINARY AS #1     'open the TGA fileπfilelength& = LOF(1)            'determine the file lengthπGET #1, 1, header               'read the headerπCLOSE #1                        'close the fileπIF ASC(header.colortyp) <> 1 THENπ                'image hasn't a DAC tableπ   PRINTπ   PRINT "Sorry! This TGA image hasn't a DAC table."π   ENDπEND IFπIF ASC(header.imagetyp) <> 1 THENπ                'data must be uncompressedπ   PRINTπ   PRINT "Sorry! This TGA format isn't supported."π   ENDπEND IFπdaclength% = header.colnumber * ASC(header.entrybits) / 8π                'calculate the length of th DAC tableπnumcolors% = daclength% / 3     'calculate the number of used colorsπdacstart& = 19 + ASC(header.info)π                'calculate the DAC startπdacend& = dacstart& + daclength%π                'calculate the DAC endπPRINTπPRINT "Information about the image:"πPRINT "============================"πPRINTπPRINT "Number of used colors  ="; header.colnumberπPRINT "Image width            ="; header.widt; "Pixel"πPRINT "Image height           ="; header.height; "Pixel"πPRINTπPRINT "Please press any key ..."πCALL WaitingπCLS                             'clear the screenπSCREEN 13                       'VGA 320 by 200 pixel and 256 colorsπOPEN file$ FOR BINARY AS #1     'open the TGA fileπSEEK #1, dacstart&              'start of the DAC tableπFOR register% = 0 TO 255        'set the DAC registersπ  temp$ = SPACE$(3)             'temporary stringπ  GET #1, , temp$               'read BGR valueπ  red% = ASC(MID$(temp$, 3)) \ 4π                'we need only 6 Bitsπ  green% = ASC(MID$(temp$, 2)) \ 4π  blue% = ASC(MID$(temp$, 1)) \ 4π  OUT &H3C8, register%          'set registerπ  OUT &H3C9, red%               'set the RGB valuesπ  OUT &H3C9, green%π  OUT &H3C9, blue%πNEXT register%πSEEK #1, dacend&                'start of the image dataπtemp$ = SPACE$(1)               'temporary stringπFOR y% = header.height - 1 TO 0 STEP -1π                'row loopπ  FOR x% = 0 TO header.widt - 1π                'column loopπ    GET #1, , temp$             'read 1 color byteπ    col% = ASC(temp$)           'calculate the color valueπ    DEF SEG = setseg%           'set the segmentπ    CALL ABSOLUTE(x%, y%, col%, setoff%)π                'set the pixelπ    DEF SEG                     'reset the segmentπ  NEXT x%πNEXT y%πCLOSE #1                        'close the fileπCALL Waiting                    'wait for a keyπDEF SEG = textseg%πCALL ABSOLUTE(textoff%)         'set the text modeπDEF SEGπCLSπENDππsetpixel:πDATA 55:        'push   bpπDATA 8B,EC:     'mov    bp,spπDATA 06:        'push   esπDATA 8B,76,08:  'mov    si,[bp+8]       ;si:=address y%πDATA 8B,7E,0A:  'mov    di,[bp+10]      ;di:=address x%πDATA 8B,5E,06:  'mov    bx,[bp+6]       ;bx:=address col%πDATA B8,40,01:  'mov    ax,320          ;ax:=320=bytes per rowπDATA 8B,0C:     'mov    cx,[si]         ;cx:=y%πDATA F7,E1:     'mul    cx              ;ax:=y%*320πDATA 03,05:     'add    ax,[si]         ;ax:=y%*320+x%πDATA 8B,F8:     'mov    di,ax           ;di:=ax=offset into video RAMπDATA B8,00,A0:  'mov    ax,0a000H       ;ax:=segment video RAMπDATA 8E,C0:     'mov    es,ax           ;es:di -> pixel positionπDATA 8B,07:     'mov    ax,[bx]         ;ax:=col%πDATA 26,88,05:  'mov    byte ptr es:[di],alπ        '                       ;set the pixelπDATA 07:        'pop    esπDATA 8B,E5:     'mov    sp,bpπDATA 5D:        'pop    bpπDATA CA,06,00:  'ret    6πDATA *:         'end codeπtextmode:πDATA B8,03,00:  'mov    ax,0003H        ;function: set text modeπDATA CD,10:     'int    10H             ;transfer to BIOSπDATA CB:        'retπDATA *:         'end codeππSUB Reading (x%, y%)π  DEF SEG = x%                  'set the segmentπ  FOR i% = 0 TO 199             'reading loopπ    READ byte$                  'read 1 byteπ    IF byte$ = "*" THEN EXIT FORπ                'end codeπ    POKE (y% + i%), VAL("&H" + byte$)π                'write 1 byteπ  NEXT i%π  DEF SEG                       'reset the segmentπEND SUBππSUB Waitingπ  WHILE INKEY$ = ""π  WENDπEND SUBπJames McMurrin                 MATHEMATICAL FORMULA DISPLAYED FidoNet QUIK_BAS Echo          08-28-96 (19:48)       QB, QBasic, PDS        31   679      FOREST.BAS  'A basic mathematical formula dressed up in a pretty wayπ'Warning: this will take a while on slower computers!π'By: James McMurrinπCOMMON SHARED NUM AS DOUBLEπSCREEN 13πFOR PU = 1 TO 255π OUT &H3C8, PUπ OUT &H3C9, PU / 2 + 20π OUT &H3C9, PU / 4 + 10π OUT &H3C9, PU / 6 + 5πNEXT PUπFOR L = 3 TO 3.996875 STEP .003125π NUM = .5π  FOR Q = 1 TO 50π   NUM = NUM * L * (1 - NUM)π  NEXT Qπ  DOπ   NUM = NUM * L * (1 - NUM)π   DISROW = 200 - (NUM * 200)π   P = POINT(DISCOL, DISROW)π   IF P = 255 THENπ    EXIT DOπ   ELSEπ    P = P + 1π    LINE (DISCOL, DISROW)-(DISCOL, DISROW), Pπ   END IFπ  LOOPπ DISCOL = DISCOL + 1πNEXT LπBEEPπWHILE INKEY$ = "": WENDπTika Carr                      INTERRUPT TUTOR                FidoNet QUIK_BAS Echo          08-03-96 (17:07)       Text, QB, PDS          313  13212    INTUTOR.BAS  =================================π[     QuickBasic 4.5 Tutorial     ]π[      How To Use Interrupts      ]π[ Copyright (c) 1996 by Tika Carr ]π =================================π(Please read disclaimer at the end of this tutorial.)ππThis tutorial hopes to cover the basics of how to use Interrupts inπQuickBasic. Note that this method only works in QuickBasic 4.5. I hopeπto do a tutorial for those who use QBasic (which comes with MS-DOS 5.0πand higher).ππ1. Getting StartedππYou will need to have started QuickBasic 4.5 by typing the followingπat the MS-DOS prompt:ππQB /L QB.QLBππThis QuickLiBrary will load in what you need to use interrupts.ππMany new programmers avoid using interrupts because they are afraid toπdamage their computer. I've noticed people mess up thier systemπ*without* using interrupts. Sections 7 - 9 have some tips on safeπdebugging and what to do if you have a crash. Further,  BACK UP YOURπHARD DRIVES! This is MOST important! And save your programs ontoπfloppy diskette before you run them. Ultimately, its still up to youπto protect your system. This goes for any type of programming.ππ2. Your First InterruptππType in the following and save it, then run it. We'll look at theπprogram and see how it all works in a moment.ππ=======>8 Snip 8<=======ππ'Example Program for CALL INTERRUPT Tutorialπ'by Tika Carrππ'$INCLUDE: 'QB.BI'ππDIM Inregs AS RegType, Outregs AS RegTypeππ'Int 10h (interrupt 10 hexidecimal) controls the video part.π'0Ah tells the computer to write a character on the screen.π'We'll put the letter 'A' on the screen in this example.ππCLSππInregs.ax = &HA41  'load high and low bytes into ax register (&H0A01)πInregs.cx = 1      'write only 1 characterππCALL INTERRUPT(&H10, Inregs, Outregs) 'put the character on the screenππ=======>8 Snip 8<=======ππ'$INCLUDE: 'QB.BI' defines the type structures used for theπinterrupts.ππDIM Inregs AS RegType, Outregs AS RegTypeππThe INCLUDE statement defines the type structures that is used forπinterrupts. These are found in the QB.BI file that comes withπQuickBasic 4.5. The DIM Statement lets you specify what variable toπput the registers defined in RegType in, so that its easy to pass allπthe registers to the interrupt.ππ3. What are registeres and what do they do?ππA register is a place where you store values, and is a more direct wayπto communicate with the computer. The computer looks into registersπfor specific values, and uses them to perform different tasks. Forπexample, we gave the computer some information in the AX register,πtelling it we wanted to write something on the screen, and what weπwanted to write to the screen (the letter 'A'). We also put a valueπinto the CX register, telling the computer we wanted to write only oneπcopy of the letter 'A'. When you call an interrupt, you send all thatπinformation along to the computer (int 10h, which accesses yourπvideo). Basically, we just told the computer to PRINT "A" on theπscreen. Registers also let the computer send information back to yourπprogram. For example, INT 33 can give your program the X and Yπcoordinates of where the mouse currently is located.ππFor CALL INTERRUPT: ax, bx, cx, dx, bp, si, di, flagsπDefined as RegTypeππFOR CALL INTERRUPTX: ax, bx, cx, dx, bp, si, di, flags, ds, esπDefined as RegTypeXππDepending on the interrupt you want to use, you will need to pick theπtype of call that suits it. For instance, if you don't use the esπregister, then using CALL INTERRUPT would work fine. However, if theπcomputer will be looking into the es register for something, or if youπwill need to know what is in the ds register, you will want to use theπCALL INTERRUPTX.ππThese definitions are all in the QB.BI file. You '$INCLUDE: 'QB.BI' inπyour program, then you DIM Inregs AS RegyType, OutRegs AS RegType.πThese will set up your variables so that you can access the registers.ππTo put something into the registers, you use Inregs, and to read theπregisters, you use the OutRegs variable:ππInregs.ax  is where you would put something in the AX register.πOutregs.cx is where you can find what the computer put in the CXπ           register.ππ4. Storing Values into Registers:ππSince the registers take information in bytes only, you may have to doπsome converting to load the registers properly. Many times anπinterrupt listing will show something like:ππInterrupt 10h: Videoπ        Entry: ah = 0A write a character to the screenπ               al = value of character to writeπ               bh = video pageπ               bl = attribute or color of characterπ               cx = number of times to write the characterππThis can seem confusing. How do you load the AX register? Where IS it?πThere's an AH and an AL. These mean the High and Low bytes of the AXπregister, respectively. Here's how you would put a value into the AXπregister:ππInregs.ax = &HA41  'load high and low bytes into ax register (&H0A01)ππ(Note that QuickBasic likes to take away the leading 0s. Initially, weπtyped it as: Inregs.ax = &H0A41)ππThe values go into the registers as:  0A41π                                      HiLoππMost of the time, you probably will run into this situation:ππVideo$ = "0A"              ' Tell computer to write to videoπCharacter$ = "A"           ' Character to write on screenππHere is how you would get it all into one register:ππCharacter$ = HEX$(ASC(A))  ' Convert 'A' into its ASCII value inπ                           ' Hexidecimal.ππSince Video$ already is in Hexidecimal, we won't need to change it.πNow, we put them together:ππAX$ = Video$ + Character$      ' AX$ now contains 0A41 PRINT AX$ toπ                                ' see for yourself.ππNow that we got the full hexidecimal value to put into the AXπregister, we still have to convert this into a *number*:ππInregs.ax = VAL("&H" + AX$)ππThis makes the string now say "&H0A41" and it also converts it into aπnumeric value (using VAL). Now you have the high and low bytesπconverted and stored into the AX register that will go into theπcomputer (Inregs). When you do the CALL INTERRUPT (&H10, Inregs,πOutregs), the values will be correctly loaded where the computer canπfind them.ππ5. Reading the RegistersππOutregs also holds register values. After you make a CALL INTERRUPT,πyou can read, let's say, the high and low bytes of the BX register andπuse it in your own program:ππBX$ = HEX$(Outregs.bx)      ' Convert the value to hexidecimal, itsπ                            ' easier to extract the high and low bytesπ                            ' this way.ππSince the computer likes to truncate leading 0s, we have to convertπthe value of BX$:ππ' Get Low and High Byte of BXπ' BH$ is the high byte, BL$ is the low byte, both in Hexidecimal.ππL = LEN(BX$)πIF L = 1 THEN BH$ = "0" + BX$: BL$ = "00"πIF L = 2 THEN BH$ = LEFT$(BX$, 2): BL$ = "00"πIF L = 3 THEN BH$ = "0" + LEFT$(BX$, 1): BL$ = RIGHT$(BX$, 2)πIF L = 4 THEN BH$ = LEFT$(BX$, 1): BL$ = RIGHT$(BX$, 2)ππbh = VAL("&H" + BH$)        ' Decimal Value of high byte of BXπbl = VAL("&H" + BL$)        ' Decimal Value of low byte of BXππNote that this is only applicable for any register you need to getπspecifically the low and high bytes of. Sometimes a register is aπpointer to a memory address. If that is the case, you can just useπthat value directly, without any type of conversion. For example:ππAddress = Outregs.esπValue = Outregs.dxπPOKE Address, Valueπ' Or do whatever you need to with the address returned.ππ6. Calling the InterruptππWhen you do a CALL INTERRUPT you access a certain function within theπcomputer. For example, in CALL INTERRUPT(&H10, Inregs, Outregs) youπcalled the video interrupt 10h (&H10). Its best of course, to knowπwhat interrupt does what, what to put into the registers, and what theπregisters may return to your program that you may be able to use. Theπbest Interrupt source I've found is Ralph Brown's Interrupt List,πfound on some programming BBSs and on the internet on different FTPπsites (like Oakland, SimTel, and Garbo, which you can get currentπaddresses for by searching Lycos at http://lycos.cs.cmu.edu)ππ7. What To Do About Crashesππa) BACKUP YOUR PROGRAMS BEFORE RUNNING THEM!πFirst and foremost, its good practice to save your program onto aπfloppy diskette before you run it. When your system crashes and youπget back in, just reload the program into QuickBasic.ππb) System CrashesπIf your system crashes, or seems to hang, first try hitting CTRL-C orπCTRL-Pause (which is also CTRL-Break). You may have to hit ENTERπafterward to get back to the QuickBasic Interactive Debugging Editorπ(IDE) to look at your program. If this don't work, reboot the computerπwith CTRL-ALT-DEL (or hit the RESET button on the computer if thatπdidn't work). Then reload and take a look at your program. If worseπcomes to worse, you can shut off the computer, wait a few moments andπturn it back on. Personally, I have always been able to recover byπbreaking out of the program with CTRL-Break.ππc) Disk FAT crashesπThis is one situation that could occur if you are using interrupts toπaccess the disk drives or hard disk, and you didn't get things loadedπin right. Best to have your hard drive backed up before eachπprogramming session if you know you'll be using interrupts that willπaccess the disk drives (ie. may have potential of writing to sectorsπor the FAT). Another good thing to have on hand is some utilities thatπrepair damaged FAT tables and such. There are a number of goodπcommercial programs out there, and some shareware ones as well. Putπone of these on a bootable floppy.ππd) Video, Sound and other hardwareπIts rare that you can actually damage hardware with an interupt call.πIf something goes "haywire" the best bet is to just hit the resetπbutton on the PC right away. Usually, things will then reset andπrecover.ππ8. Safe DebuggingππOnce you get your program written, put a remark before the CALLπINTERRUPT:ππ'CALL INTERRUPT (&H10, Inregs, Outregs)ππThen set up the Debug to watch your variables:ππHEX$(Inregs.ax)πHEX$(Outresg.bx)ππOr whatever variables you are working with. Then ALT-R R to restart.πNOW SAVE THE PROGRAM TO FLOPPY DISK! Remove the disk from the drive.πHit F8 to step through your program one instruction at a time, payingπclose attention to the values in the variables. Are they loadingπproperly? Once you think its working, you can again save the programπand then remove the remark from the call. Step through again and payπattention to the Outregs registers if you are using them.ππIt may seem like a lot to go through, but watching how your programπworks step by step, especially if you're first learning to useπinterrupts, will show you how the computer uses them, and how yourπprograms behave (for better or for worse).ππ9. In Closing....ππInterrupts are a great way to do things in QuickBasic that you can'tπfind a command for. Normally, they don't hurt anything and at worse,πjust make you have to restart the computer. While a risk is there toπmess up things like hard drives, its rare you'll run into that, if atπall, as long as you don't use disk interrupts until you areπcomfortable with how interrupts work and how to use them. Stick withπwriting for video, mouse, printer, sound card for starters. Video isπeasiest, as is the mouse. And if wierd things happen, don't panic -πreset. :)ππ                    ******* DISCLAIMER *******ππThe author of this article cannot garantee the usability orπsuitability of the inforamtion presented herein for any particularπpurpose. In addition, the user of the information in this articleπagrees not to hold the author, moderator or any other direct orπindirect agent liable in any way for any damages, loss of data, orπother consequenses arising from use of this information. While I haveπmade every conscious effort to ensure the information in this tutorialπis accurate and safe to use on any PC compatible in the QuickBasic 4.5πenvironment, the end result depends on the person making use of theπintformation presented here. Use the information in this tutorial atπyour own risk.ππ                  ******* CONTACT INFORMATION *******ππAs of 8/3/96, comments, questions and suggestions, can be directed to:ππ FidoNet: Tika Carr 1:2613/601πInternet: [e-mail]ππ=====================================================================πTika Carr, former staff writer and later editor of GEnieLamp PCπMultimedia Magazine, has been writing QuickBasic 4.5 programs sinceπ1989, and is a frequent contributor to the QUICK_BAS FidoNet Echo. Herπarea of specialty is in "tools that make tools" (Steven Levy,π"Hackers"), meaning anything that will make things easier forπprogrammers to take control of the computer, and make theirπimaginations come alive.π=====================================================================πMicrosoft, QuickBasic 4.5, and QBasic are trademarks of MicrosoftπCorporation. MS-DOS is a registered trademark of MicrosoftπCorporation.πRichard J. Backus              INTERRUPTS IN QBASIC           FidoNet QUIK_BAS Echo          12-27-95 (00:00)       QBasic                 139  5942     BASICDOS.BAS'Thought I'd repost this as its been awhile since I last posted:ππ'A tutorial for Richard Backus' BASICDOS.BAS code.  Here isπ'the code in the original form that he sent to me:ππ'===========>8 CLIP 8<============ππ'       BASICDOS.BASπ' written: Richard J Backus     27dec95π' purpose: to provide a BASIC BIOS/DOS call interfaceπ' method: using the CALL interface, get registers, call the interrupt, andπ'       return the registers. Based on QuickBasic's CALL INTERRUPT routine.π' Warning: Calls requiring segment registers cannot be used.ππ' QBasic syntax: CALL ABSOLUTE(intnum%, callregs, retregs, VARPTR(asmcode)))π'   intnum%   a valid DOS interrupt number between 0 and 255, type INTEGERπ'   callregs  register values required by call, type REGSπ'   retregs   register values returned from call, type REGSπTYPE REGS       'Typedef for DOS registersπ   ax  AS INTEGERπ   bx  AS INTEGERπ   cx  AS INTEGERπ   dx  AS INTEGERπ   bp  AS INTEGERπ   si  AS INTEGERπ   di  AS INTEGERπ   flg AS INTEGERπEND TYPEπ'       DOS call codeπDATA &H55, &H06, &H1E, &H8B, &HEC, &H9C, &H8B, &H7E, &H0E, &H8AπDATA &H05, &H8B, &H7E, &H0C, &HB4, &H35, &HCD, &H21, &H8B, &H46πDATA &HF8, &H05, &H20, &H00, &H0E, &H50, &H06, &H53, &H8B, &H05πDATA &H8B, &H5D, &H02, &H8B, &H4D, &H04, &H8B, &H55, &H06, &H8BπDATA &H6D, &H08, &H8B, &H75, &H0A, &H8B, &H7D, &H0C, &HFA, &HCBπDATA &H1F, &H07, &H57, &H9C, &H8B, &HFC, &H36, &H8B, &H7D, &H0AπDATA &H89, &H05, &H89, &H5D, &H02, &H89, &H4D, &H04, &H89, &H55πDATA &H06, &H89, &H6D, &H08, &H89, &H75, &H0A, &H58, &H89, &H45πDATA &H0E, &H58, &H89, &H45, &H0C, &H5D, &HCA, &H06, &H00π'       Load DOS/BIOS interface routineπDIM dos%(45)                    'get some memory spaceπDEF SEG = VARSEG(dos%(0))πFOR i% = 0 TO 88π   READ d%π   POKE VARPTR(dos%(0))+i%, d%  'copy code into memoryπNEXT i%ππ'       Message stringπDATA &H48, &H65, &H6C, &H6C, &H6F, &H20, &H57, &H6F, &H72, &H6CπDATA &H64, &H0D, &H0Aπ'       use DOS to output the messageπDIM dosregs AS REGSπFOR i% = 0 TO 12π   intnum% = &H21               'parameters for callπ   dosregs.ax% = &H200π   READ dosregs.dx%π   DEF SEG = VARSEG(dos%(0))    'set call segπ   CALL ABSOLUTE(intnum%, dosregs, dosregs, VARPTR(dos%(0)))πNEXT i%πENDππ'=============>8 CLIP 8<================ππ'TYPE REGS will set up the variable REGS to access all the registersπ'you need to make a BIOS call.  This goes in hand with teh DIM dosregsπ'as REGS.  Dosregs will contain the information of the registers.  Forπ'example, if you want to send a value to the AX register, you can setπ'dosregs.ax=value.  I'm not great at explaining how TYPE works, so bestπ'consult some books (or the help file) on that one. :)ππ'Next he has his assembly routine that emulates CALL INTERRUPT.  Thisπ'and the code under it that pokes the routine into memory is the heartπ'of the whole thing.ππ'Next, he creates the data for each character in the string "Helloπ'World" and he uses a BIOS video call to place each character on theπ'screen (much the same way my GPrint routine does in my GUI interface).π'π'Note how he used CALL ABSOLUTE.  Lets compare it with QB45's CALLπ'INTERRUPT syntax:ππ'QB45:   CALL INTERRUPT (intnum%, dosregs, dosregs)π'QBASIC: CALL ABSOLUTE (intnum%, dosregs, dosregs, VARPTR(dos%(0)))ππ'Notice all is basically the _same_, you just add the VARPTR at theπ'end! And don't forget to change INTERRUPT to ABSOLUTE.  This makes itπ'very easy to change a QB45 code to work with QBasic.ππ'Now, I will try and explain how you can convert QB45 code that usesπ'CALL INTERRUPT so that it will work in QBasic.  Of course, you'll needπ'the code written by Richard Backus (which was posted in the previousπ'message).  Also note this works only for the CALL INTERRUPT calls.  Ifπ'you see CALL INTERRUPTX or CALL INT86, I'm not sure how it will workπ'with those, as they take slightly different parameters.ππ'First off, the QB45 program will have a '$INCLUDE statemtent in it.π'You must delete that statement.  Next, put the TYPE REGS in AFTER theπ'DECLARE SUB and DECLARE FUNCTION statements (if any). You'll want toπ'more than likely change REGS to RegType, as that is what the qb.bi wasπ'using.  This will replace it.ππ'Now, put the DIM SHARED Inregs as RegType, Outregs as RegType with theπ'DIM statements, if there isn't one there already.  Most often thanπ'not, it may not need changing.  Also add in DIM SHARED dos%(45) andπ'DEF SEG = VARSEG(dos%(0)).  It should look something like this:ππ'DIM and CONST, etc. hereπ'DIM SHARED Inregs as RegType, Outregs as RegTypeπ'DIM SHARED dos%(45)π'DEF SEG = VARSEG(dos%(0))ππ'Once you have the variables all set up, next slip the DOS Call Codeπ'data statements and teh Load DOS/BIOS interface routine just beforeπ'the main code of the program starts.  Most of the time, there's a CLSπ'or SCREEN statement there.ππ'Now just one more step.  Look through the code (may want to do aπ'search for CALL INTERRUPT).  You will need to change each occurance ofπ'INTERRUPT to ABSOLUTE.  And, you will need to add to the end of eachπ'CALL ABSOLUTE (which was a CALL INTERRUPT) the VARPTR statement.  Forπ'example, suppose the QB45 code read:ππ'  CALL INTERRUPT (intnum%, Inregs, Outregs)ππ'You would change it to read:ππ'  CALL ABSOLUTE (intnum%, Inregs, Outregs, VARPTR(dos%(0)))ππ'Be sure to get all the parenthesis right!  There's _3_ of them at theπ'end of the ABSOLUTE statement (I say this because I'm bad at it andπ'forget alot! :)ππ'Now you can save the new code to a new file name (for safe keeping)π'and run it.  It should work!ππ'If you have any questions, let me know.  I can't promise I'll be ableπ'to have an answer every time but I'll try.  If you need to contactπ'Richard, net mail me and I'll forward your question or whatever toπ'him.  Just a short note that he does most of his programming inπ'assembly. :)πChris Sugden                   LIBERTY YAHTZEE                [e-mail]          07-10-96 (20:53)       LB                     973  34265    YAHTZEE.BAS [Start]πprint "  |           |       |        |          | ||||||||||||||| |||||||||| ||||||||| ||||||||||"πprint "   |         |       | |       |          |        |                 | |         |         "πprint "    |       |       |   |      |          |        |                |  |         |         "πprint "     |     |       |     |     |          |        |               |   |         |         "πprint "      |   |       |       |    |          |        |              |    |         |         "πprint "       | |       |         |   ||||||||||||        |             |     ||||||||| ||||||||||"πprint "        |        |||||||||||   |          |        |            |      |         |         "πprint "        |        |         |   |          |        |           |       |         |         "πprint "        |        |         |   |          |        |          |        |         |         "πprint "        |        |         |   |          |        |         |         |         |         "πprint "        |        |         |   |          |        |        |          |         |         "πprint "        |        |         |   |          |        |        |||||||||| ||||||||| ||||||||||"πprint ""πprint ""πinput "Do you want to read some brief rules?";readrules$πif instr("YESYesyes",readrules$) > 0 then goto [Rules]πprint ""πinput "Press Enter to continue";enterπif enter = 0 then goto [RollDice]ππ[RollDice]πlet Reroll = 0πlet Count = Count + 1πlet Turns = Count - 1πclsπlet total = acestotal + twostotal + threestotal + fourstotal + fivestotal + sixestotal + threescore + fourscore + FullScore + LowScore + highScore + Yatzeescore + DiceSumπprint "After ";Turns;" turns, your score is ";total;"."πprint ""πprint "Dice being rolled..."πgoto [Dice1]ππ[Dice1]πlet Dice1 = int(rnd(1)*6)+1πgoto [Dice2]ππ[Dice2]πlet Dice2 = int(rnd(1)*6)+1πgoto [Dice3]ππ[Dice3]πlet Dice3 = int(rnd(1)*6)+1πgoto [Dice4]ππ[Dice4]πlet Dice4 = int(rnd(1)*6)+1πgoto [Dice5]ππ[Dice5]πlet Dice5 = int(rnd(1)*6)+1πgoto [Choose]ππ[Choose]πprint "OK. This is how the dice came out:"πprint "Dice 1 came up as ";Dice1;"."πprint "Dice 2 came up as ";Dice2;"."πprint "Dice 3 came up as ";Dice3;"."πprint "Dice 4 came up as ";Dice4;"."πprint "Dice 5 came up as ";Dice5;"."πprint ""πinput "Do you want to reroll any of the dice?";reroll$πif instr("YESYesyes",reroll$) > 0 then goto [Reroll]πgoto [Score]ππ[Score]πprint "You have a choice of how you want to score."πprint ""πprint "You can do:"πprint "Aces, Twos, Threes, Fours, Fives, Sixes,"πprint "3 Of A Kind, 4 Of A Kind, Full House, Low Straight,"πprint "High Straight, Yahtzee or Chance."πprint ""πinput "Do you want help on any of the scoring possibilities?";help$πif instr("YESYesyes",help$) > 0 then goto [Help]πgoto [ChooseScore]ππ[ChooseScore]πinput "DO YOU WANT TO CONTINUE?";continue$πif instr("NOnoNo",continue$) > 0 then goto [Bonus]πprint "So how are you going to score?"πprint ""πprint "Please type in the first word or number of each scoring"πinput "possibility, such as '3' for '3 Of A Kind'.";score$πgoto [ChooseAces]ππ[ChooseAces]πif instr("ACESacesAces",score$) > 0 then goto [Aces]πgoto [ChooseTwos]ππ[ChooseTwos]πif instr("TWOSTwostwos",score$) > 0 then goto [Twos]πgoto [ChooseThrees]ππ[ChooseThrees]πif instr("THREESThreesthrees",score$) > 0 then goto [Threes]πgoto [ChooseFours]ππ[ChooseFours]πif instr("FOURSfoursFours",score$) > 0 then goto [Fours]πgoto [ChooseFives]ππ[ChooseFives]πif instr("FivesfivesFIVES",score$) > 0 then goto [Fives]πgoto [ChooseSixes]ππ[ChooseSixes]πif instr("SIXESsixesSixes",score$) > 0 then goto [Sixes]πgoto [Choose3OfAKind]ππ[Choose3OfAKind]πif instr("3",score$) > 0 then goto [3OfAKind]πgoto [Choose4OfAKind]ππ[Choose4OfAKind]πif instr("4",score$) > 0 then goto [4OfAKind]πgoto [ChooseFullHouse]ππ[ChooseFullHouse]πif instr("FullFullfull",score$) > 0 then goto [FullHouse]πgoto [ChooseLowStraight]ππ[ChooseLowStraight]πif instr("LOWlowLow",score$) > 0 then goto [LowStraight]πgoto [ChooseHighStraight]ππ[ChooseHighStraight]πif instr("HIGHHighhigh",score$) > 0 then goto [HighStraight]πgoto [ChooseYahtzee]ππ[ChooseYahtzee]πif instr("YAHTZEEYahtzeeyahtzee",score$) > 0 then goto [Yahtzee]πgoto [ChooseChance]ππ[ChooseChance]πif instr("CHANCEChancechance",score$) > 0 then goto [Chance]πgoto [Unknown]ππ[Unknown]πclsπprint "There is no such scoring possibility!"πprint "Try again."πprint ""πgoto [ChooseScore]ππ[Aces]πlet AcesCount = AcesCount + 1πif AcesCount > 1 then goto [AlreadyChosen]πif Dice1 = 1 then let total = total + 1πif Dice2 = 1 then let total = total + 1πif Dice3 = 1 then let total = total + 1πif Dice4 = 1 then let total = total + 1πif Dice5 = 1 then let total = total + 1πif Dice1 = 1 then let acestotal = acestotal + 1πif Dice2 = 1 then let acestotal = acestotal + 1πif Dice3 = 1 then let acestotal = acestotal + 1πif Dice4 = 1 then let acestotal = acestotal + 1πif Dice5 = 1 then let acestotal = acestotal + 1πprint "That turn you won ";acestotal;" points."πinput "Press Enter to continue";enter1πgoto [RollDice]ππ[Twos]πlet TwosCount = TwosCount + 1πif TwosCount > 1 then goto [AlreadyChosen]πif Dice1 = 2 then let total = total + 2πif Dice2 = 2 then let total = total + 2πif Dice3 = 2 then let total = total + 2πif Dice4 = 2 then let total = total + 2πif Dice5 = 2 then let total = total + 2πif Dice1 = 2 then let twostotal = twostotal + 2πif Dice2 = 2 then let twostotal = twostotal + 2πif Dice3 = 2 then let twostotal = twostotal + 2πif Dice4 = 2 then let twostotal = twostotal + 2πif Dice5 = 2 then let twostotal = twostotal + 2πprint "That turn you won ";twostotal;" points."πinput "Press Enter to continue";enter2πgoto [RollDice]ππ[Threes]πlet ThreesCount = ThreesCount + 1πif ThreesCount > 1 then goto [AlreadyChosen]πif Dice1 = 3 then let total = total + 3πif Dice2 = 3 then let total = total + 3πif Dice3 = 3 then let total = total + 3πif Dice4 = 3 then let total = total + 3πif Dice5 = 3 then let total = total + 3πif Dice1 = 3 then let threestotal = threestotal + 3πif Dice2 = 3 then let threestotal = threestotal + 3πif Dice3 = 3 then let threestotal = threestotal + 3πif Dice4 = 3 then let threestotal = threestotal + 3πif Dice5 = 3 then let threestotal = threestotal + 3πprint "That turn you won ";threestotal;" points."πinput "Press Enter to continue";enter3πgoto [RollDice]ππ[Fours]πlet FoursCount = FoursCount + 1πif FoursCount > 1 then goto [AlreadyChosen]πif Dice1 = 4 then let total = total + 4πif Dice2 = 4 then let total = total + 4πif Dice3 = 4 then let total = total + 4πif Dice4 = 4 then let total = total + 4πif Dice5 = 4 then let total = total + 4πif Dice1 = 4 then let fourstotal = fourstotal + 4πif Dice2 = 4 then let fourstotal = fourstotal + 4πif Dice3 = 4 then let fourstotal = fourstotal + 4πif Dice4 = 4 then let fourstotal = fourstotal + 4πif Dice5 = 4 then let fourstotal = fourstotal + 4πprint "That turn you won ";fourstotal;" points."πinput "Press Enter to continue";enter4πgoto [RollDice]ππ[Fives]πlet FivesCount = FivesCount + 1πif FivesCount > 1 then goto [AlreadyChosen]πif Dice1 = 5 then let total = total + 5πif Dice2 = 5 then let total = total + 5πif Dice3 = 5 then let total = total + 5πif Dice4 = 5 then let total = total + 5πif Dice5 = 5 then let total = total + 5πif Dice1 = 5 then let fivestotal = fivestotal + 5πif Dice2 = 5 then let fivestotal = fivestotal + 5πif Dice3 = 5 then let fivestotal = fivestotal + 5πif Dice4 = 5 then let fivestotal = fivestotal + 5πif Dice5 = 5 then let fivestotal = fivestotal + 5πprint "That turn you won ";fivestotal;" points."πinput "Press Enter to continue";enter4πgoto [RollDice]ππ[Sixes]πlet SixesCount = SixesCount + 1πif SixesCount > 1 then goto [AlreadyChosen]πif Dice1 = 6 then let total = total + 6πif Dice2 = 6 then let total = total + 6πif Dice3 = 6 then let total = total + 6πif Dice4 = 6 then let total = total + 6πif Dice5 = 6 then let total = total + 6πif Dice1 = 6 then let sixestotal = sixestotal + 6πif Dice2 = 6 then let sixestotal = sixestotal + 6πif Dice3 = 6 then let sixestotal = sixestotal + 6πif Dice4 = 6 then let sixestotal = sixestotal + 6πif Dice5 = 6 then let sixestotal = sixestotal + 6πprint "That turn you won ";sixestotal;" points."πinput "Press Enter to continue";enter4πgoto [RollDice]ππ[3OfAKind]πlet threeOfCount = threeOfCount + 1πif threeOfCount > 1 then goto [AlreadyChosen]πif Dice1 = Dice2 then goto [3OK12]πif Dice1 = Dice3 then goto [3OK13]πif Dice1 = Dice4 then goto [3OK14]πif Dice1 = Dice5 then goto [3OK15]πif Dice2 = Dice3 then goto [3OK23]πif Dice2 = Dice4 then goto [3OK24]πif Dice2 = Dice5 then goto [3OK25]πif Dice3 = Dice4 then goto [3OK34]πif Dice3 = Dice5 then goto [3OK35]πif Dice4 = Dice5 then goto [3OK45]πgoto [NO3OF]ππ[NO3OF]πprint "Sorry, you don't have 3 Of A Kind."πprint "Try again."πprint ""πgoto [Choosescore]ππ[3OK12]πif Dice1 = Dice3 then goto [OK3]πif Dice1 = Dice4 then goto [OK3]πif Dice1 = Dice5 then goto [OK3]πgoto [NO3OF]ππ[3OK13]πif Dice1 = Dice2 then goto [OK3]πif Dice1 = Dice4 then goto [OK3]πif Dice1 = Dice5 then goto [OK3]πgoto [NO3OF]ππ[3OK14]πif Dice1 = Dice2 then goto [OK3]πif Dice1 = Dice3 then goto [OK3]πif Dice1 = Dice5 then goto [OK3]πgoto [NO3OF]ππ[3OK15]πif Dice1 = Dice2 then goto [OK3]πif Dice1 = Dice3 then goto [OK3]πif Dice1 = Dice4 then goto [OK3]πgoto [NO3OF]ππ[3OK23]πif Dice2 = Dice1 then goto [OK3]πif Dice2 = Dice4 then goto [OK3]πif Dice2 = Dice5 then goto [OK3]πgoto [NO3OF]ππ[3OK24]πif Dice2 = Dice3 then goto [OK3]πif Dice2 = Dice1 then goto [OK3]πif Dice2 = Dice5 then goto [OK3]πgoto [NO3OF]ππ[3OK25]πif Dice2 = Dice1 then goto [OK3]πif Dice2 = Dice3 then goto [OK3]πif Dice2 = Dice4 then goto [OK3]πgoto [NO3OF]ππ[3OK34]πif Dice3 = Dice1 then goto [OK3]πif Dice3 = Dice2 then goto [OK3]πif Dice3 = Dice5 then goto [OK3]πgoto [NO3OF]ππ[3OK35]πif Dice3 = Dice1 then goto [OK3]πif Dice3 = Dice2 then goto [OK3]πif Dice3 = Dice4 then goto [OK3]πgoto [NO3OF]ππ[3OK45]πif Dice4 = Dice1 then goto [OK3]πif Dice4 = Dice2 then goto [OK3]πif Dice4 = Dice3 then goto [OK3]πgoto [NO3OF]ππ[OK3]πlet threescore = Dice1 + Dice2 + Dice3 + Dice4 + Dice5πprint "That turn you won ";threescore;" points."πinput "Press Enter to continue";enter5πgoto [RollDice]ππ[4OfAKind]πlet fourOfCount = fourOfCount + 1πif fourOfCount > 1 then goto [AlreadyChosen]πlet AllDice$ = "";Dice1;"";Dice2;"";Dice3;"";Dice4;"";Dice5;""πif instr(AllDice$,"11111") > 0 then goto [OK4]πif instr(AllDice$,"21111") > 0 then goto [OK4]πif instr(AllDice$,"31111") > 0 then goto [OK4]πif instr(AllDice$,"41111") > 0 then goto [OK4]πif instr(AllDice$,"51111") > 0 then goto [OK4]πif instr(AllDice$,"61111") > 0 then goto [OK4]πif instr(AllDice$,"11111") > 0 then goto [OK4]πif instr(AllDice$,"12111") > 0 then goto [OK4]πif instr(AllDice$,"13111") > 0 then goto [OK4]πif instr(AllDice$,"14111") > 0 then goto [OK4]πif instr(AllDice$,"15111") > 0 then goto [OK4]πif instr(AllDice$,"16111") > 0 then goto [OK4]πif instr(AllDice$,"11111") > 0 then goto [OK4]πif instr(AllDice$,"11211") > 0 then goto [OK4]πif instr(AllDice$,"11311") > 0 then goto [OK4]πif instr(AllDice$,"11411") > 0 then goto [OK4]πif instr(AllDice$,"11511") > 0 then goto [OK4]πif instr(AllDice$,"11611") > 0 then goto [OK4]πif instr(AllDice$,"11111") > 0 then goto [OK4]πif instr(AllDice$,"11121") > 0 then goto [OK4]πif instr(AllDice$,"11131") > 0 then goto [OK4]πif instr(AllDice$,"11141") > 0 then goto [OK4]πif instr(AllDice$,"11151") > 0 then goto [OK4]πif instr(AllDice$,"11161") > 0 then goto [OK4]πif instr(AllDice$,"11111") > 0 then goto [OK4]πif instr(AllDice$,"11112") > 0 then goto [OK4]πif instr(AllDice$,"11113") > 0 then goto [OK4]πif instr(AllDice$,"11114") > 0 then goto [OK4]πif instr(AllDice$,"11115") > 0 then goto [OK4]πif instr(AllDice$,"11116") > 0 then goto [OK4]πif instr(AllDice$,"22222") > 0 then goto [OK4]πif instr(AllDice$,"32222") > 0 then goto [OK4]πif instr(AllDice$,"42222") > 0 then goto [OK4]πif instr(AllDice$,"52222") > 0 then goto [OK4]πif instr(AllDice$,"62222") > 0 then goto [OK4]πif instr(AllDice$,"12222") > 0 then goto [OK4]πif instr(AllDice$,"21222") > 0 then goto [OK4]πif instr(AllDice$,"22222") > 0 then goto [OK4]πif instr(AllDice$,"23222") > 0 then goto [OK4]πif instr(AllDice$,"24222") > 0 then goto [OK4]πif instr(AllDice$,"25222") > 0 then goto [OK4]πif instr(AllDice$,"26222") > 0 then goto [OK4]πif instr(AllDice$,"22122") > 0 then goto [OK4]πif instr(AllDice$,"22222") > 0 then goto [OK4]πif instr(AllDice$,"22322") > 0 then goto [OK4]πif instr(AllDice$,"22422") > 0 then goto [OK4]πif instr(AllDice$,"22522") > 0 then goto [OK4]πif instr(AllDice$,"22622") > 0 then goto [OK4]πif instr(AllDice$,"22212") > 0 then goto [OK4]πif instr(AllDice$,"22222") > 0 then goto [OK4]πif instr(AllDice$,"22232") > 0 then goto [OK4]πif instr(AllDice$,"22242") > 0 then goto [OK4]πif instr(AllDice$,"22252") > 0 then goto [OK4]πif instr(AllDice$,"22262") > 0 then goto [OK4]πif instr(AllDice$,"22221") > 0 then goto [OK4]πif instr(AllDice$,"22222") > 0 then goto [OK4]πif instr(AllDice$,"22223") > 0 then goto [OK4]πif instr(AllDice$,"22224") > 0 then goto [OK4]πif instr(AllDice$,"22225") > 0 then goto [OK4]πif instr(AllDice$,"22226") > 0 then goto [OK4]πif instr(AllDice$,"13333") > 0 then goto [OK4]πif instr(AllDice$,"23333") > 0 then goto [OK4]πif instr(AllDice$,"33333") > 0 then goto [OK4]πif instr(AllDice$,"43333") > 0 then goto [OK4]πif instr(AllDice$,"53333") > 0 then goto [OK4]πif instr(AllDice$,"63333") > 0 then goto [OK4]πif instr(AllDice$,"31333") > 0 then goto [OK4]πif instr(AllDice$,"32333") > 0 then goto [OK4]πif instr(AllDice$,"33333") > 0 then goto [OK4]πif instr(AllDice$,"34333") > 0 then goto [OK4]πif instr(AllDice$,"35333") > 0 then goto [OK4]πif instr(AllDice$,"36333") > 0 then goto [OK4]πif instr(AllDice$,"33133") > 0 then goto [OK4]πif instr(AllDice$,"33233") > 0 then goto [OK4]πif instr(AllDice$,"33333") > 0 then goto [OK4]πif instr(AllDice$,"33433") > 0 then goto [OK4]πif instr(AllDice$,"33533") > 0 then goto [OK4]πif instr(AllDice$,"33633") > 0 then goto [OK4]πif instr(AllDice$,"33313") > 0 then goto [OK4]πif instr(AllDice$,"33323") > 0 then goto [OK4]πif instr(AllDice$,"33333") > 0 then goto [OK4]πif instr(AllDice$,"33343") > 0 then goto [OK4]πif instr(AllDice$,"33353") > 0 then goto [OK4]πif instr(AllDice$,"33363") > 0 then goto [OK4]πif instr(AllDice$,"33331") > 0 then goto [OK4]πif instr(AllDice$,"33332") > 0 then goto [OK4]πif instr(AllDice$,"33333") > 0 then goto [OK4]πif instr(AllDice$,"33334") > 0 then goto [OK4]πif instr(AllDice$,"33335") > 0 then goto [OK4]πif instr(AllDice$,"33336") > 0 then goto [OK4]πif instr(AllDice$,"14444") > 0 then goto [OK4]πif instr(AllDice$,"24444") > 0 then goto [OK4]πif instr(AllDice$,"34444") > 0 then goto [OK4]πif instr(AllDice$,"44444") > 0 then goto [OK4]πif instr(AllDice$,"54444") > 0 then goto [OK4]πif instr(AllDice$,"64444") > 0 then goto [OK4]πif instr(AllDice$,"41444") > 0 then goto [OK4]πif instr(AllDice$,"42444") > 0 then goto [OK4]πif instr(AllDice$,"43444") > 0 then goto [OK4]πif instr(AllDice$,"44444") > 0 then goto [OK4]πif instr(AllDice$,"45444") > 0 then goto [OK4]πif instr(AllDice$,"46444") > 0 then goto [OK4]πif instr(AllDice$,"44144") > 0 then goto [OK4]πif instr(AllDice$,"44244") > 0 then goto [OK4]πif instr(AllDice$,"44344") > 0 then goto [OK4]πif instr(AllDice$,"44444") > 0 then goto [OK4]πif instr(AllDice$,"44544") > 0 then goto [OK4]πif instr(AllDice$,"44644") > 0 then goto [OK4]πif instr(AllDice$,"44414") > 0 then goto [OK4]πif instr(AllDice$,"44424") > 0 then goto [OK4]πif instr(AllDice$,"44434") > 0 then goto [OK4]πif instr(AllDice$,"44444") > 0 then goto [OK4]πif instr(AllDice$,"44454") > 0 then goto [OK4]πif instr(AllDice$,"44464") > 0 then goto [OK4]πif instr(AllDice$,"44441") > 0 then goto [OK4]πif instr(AllDice$,"44442") > 0 then goto [OK4]πif instr(AllDice$,"44443") > 0 then goto [OK4]πif instr(AllDice$,"44444") > 0 then goto [OK4]πif instr(AllDice$,"44445") > 0 then goto [OK4]πif instr(AllDice$,"44446") > 0 then goto [OK4]πif instr(AllDice$,"15555") > 0 then goto [OK4]πif instr(AllDice$,"25555") > 0 then goto [OK4]πif instr(AllDice$,"35555") > 0 then goto [OK4]πif instr(AllDice$,"45555") > 0 then goto [OK4]πif instr(AllDice$,"55555") > 0 then goto [OK4]πif instr(AllDice$,"65555") > 0 then goto [OK4]πif instr(AllDice$,"51555") > 0 then goto [OK4]πif instr(AllDice$,"52555") > 0 then goto [OK4]πif instr(AllDice$,"53555") > 0 then goto [OK4]πif instr(AllDice$,"54555") > 0 then goto [OK4]πif instr(AllDice$,"55555") > 0 then goto [OK4]πif instr(AllDice$,"56555") > 0 then goto [OK4]πif instr(AllDice$,"55155") > 0 then goto [OK4]πif instr(AllDice$,"55255") > 0 then goto [OK4]πif instr(AllDice$,"55355") > 0 then goto [OK4]πif instr(AllDice$,"55455") > 0 then goto [OK4]πif instr(AllDice$,"55555") > 0 then goto [OK4]πif instr(AllDice$,"55655") > 0 then goto [OK4]πif instr(AllDice$,"55515") > 0 then goto [OK4]πif instr(AllDice$,"55525") > 0 then goto [OK4]πif instr(AllDice$,"55535") > 0 then goto [OK4]πif instr(AllDice$,"55545") > 0 then goto [OK4]πif instr(AllDice$,"55555") > 0 then goto [OK4]πif instr(AllDice$,"55565") > 0 then goto [OK4]πif instr(AllDice$,"55551") > 0 then goto [OK4]πif instr(AllDice$,"55552") > 0 then goto [OK4]πif instr(AllDice$,"55553") > 0 then goto [OK4]πif instr(AllDice$,"55554") > 0 then goto [OK4]πif instr(AllDice$,"55555") > 0 then goto [OK4]πif instr(AllDice$,"55556") > 0 then goto [OK4]πif instr(AllDice$,"16666") > 0 then goto [OK4]πif instr(AllDice$,"26666") > 0 then goto [OK4]πif instr(AllDice$,"36666") > 0 then goto [OK4]πif instr(AllDice$,"46666") > 0 then goto [OK4]πif instr(AllDice$,"56666") > 0 then goto [OK4]πif instr(AllDice$,"66666") > 0 then goto [OK4]πif instr(AllDice$,"61666") > 0 then goto [OK4]πif instr(AllDice$,"62666") > 0 then goto [OK4]πif instr(AllDice$,"63666") > 0 then goto [OK4]πif instr(AllDice$,"64666") > 0 then goto [OK4]πif instr(AllDice$,"65666") > 0 then goto [OK4]πif instr(AllDice$,"66666") > 0 then goto [OK4]πif instr(AllDice$,"66166") > 0 then goto [OK4]πif instr(AllDice$,"66266") > 0 then goto [OK4]πif instr(AllDice$,"66366") > 0 then goto [OK4]πif instr(AllDice$,"66466") > 0 then goto [OK4]πif instr(AllDice$,"66566") > 0 then goto [OK4]πif instr(AllDice$,"66666") > 0 then goto [OK4]πif instr(AllDice$,"66616") > 0 then goto [OK4]πif instr(AllDice$,"66626") > 0 then goto [OK4]πif instr(AllDice$,"66636") > 0 then goto [OK4]πif instr(AllDice$,"66646") > 0 then goto [OK4]πif instr(AllDice$,"66656") > 0 then goto [OK4]πif instr(AllDice$,"66666") > 0 then goto [OK4]πif instr(AllDice$,"66661") > 0 then goto [OK4]πif instr(AllDice$,"66662") > 0 then goto [OK4]πif instr(AllDice$,"66663") > 0 then goto [OK4]πif instr(AllDice$,"66664") > 0 then goto [OK4]πif instr(AllDice$,"66665") > 0 then goto [OK4]πif instr(AllDice$,"66666") > 0 then goto [OK4]πprint "Sorry, you don't have 4 Of A Kind."πprint "Try again."πprint ""πgoto [ChooseScore]ππ[OK4]πlet fourscore = Dice1 + Dice2 + Dice3 + Dice4 + Dice5πprint "That turn you won ";fourscore;" points."πinput "Press Enter to continue";enter6πgoto [RollDice]ππ[FullHouse]πlet fullHousecount = fullHouseCount + 1πif fullHouseCount > 1 then goto [AlreadyChosen]πlet FullScore = 0πif Dice1 = Dice2 then goto [Full12]πif Dice1 = Dice3 then goto [Full13]πif Dice1 = Dice4 then goto [Full14]πif Dice1 = Dice5 then goto [Full15]πif Dice2 = Dice3 then goto [Full23]πif Dice2 = Dice4 then goto [Full24]πif Dice2 = Dice5 then goto [Full25]πif Dice3 = Dice4 then goto [Full34]πif Dice3 = Dice5 then goto [Full35]πif Dice4 = Dice5 then goto [Full45]πgoto [NoFull]ππ[NoFull]πprint "Sorry, you don't have a Full House."πprint "Try again."πprint ""πgoto [ChooseScore]ππ[Full12]πif Dice1 = Dice3 then goto [Full123]πif Dice1 = Dice4 then goto [Full124]πif Dice1 = Dice5 then goto [Full125]πgoto [Full345]ππ[Full13]πif Dice1 = Dice2 then goto [Full123]πif Dice1 = Dice4 then goto [Full134]πif Dice1 = Dice5 then goto [Full135]πgoto [Full245]ππ[Full14]πif Dice1 = Dice2 then goto [Full124]πif Dice1 = Dice3 then goto [Full134]πif Dice1 = Dice5 then goto [Full145]πgoto [Full235]ππ[Full15]πif Dice1 = Dice2 then goto [Full125]πif Dice1 = Dice3 then goto [Full135]πif Dice1 = Dice4 then goto [Full145]πgoto [Full234]ππ[Full23]πif Dice2 = Dice4 then goto [Full234]πif Dice2 = Dice1 then goto [Full123]πif Dice2 = Dice5 then goto [Full235]πgoto [Full145]ππ[Full24]πif Dice2 = Dice1 then goto [Full124]πif Dice2 = Dice3 then goto [Full234]πif Dice2 = Dice5 then goto [Full245]πgoto [Full135]ππ[Full25]πif Dice2 = Dice1 then goto [Full125]πif Dice2 = Dice3 then goto [Full235]πif Dice2 = Dice4 then goto [Full245]πgoto [Full134]ππ[Full34]πif Dice3 = Dice1 then goto [Full134]πif Dice3 = Dice2 then goto [Full234]πif Dice3 = Dice5 then goto [Full345]πgoto [Full125]ππ[Full35]πif Dice3 = Dice1 then goto [Full135]πif Dice3 = Dice2 then goto [Full235]πif Dice3 = Dice4 then goto [Full345]πgoto [Full124]ππ[Full45]πif Dice4 = Dice1 then goto [Full145]πif Dice4 = Dice2 then goto [Full245]πif Dice4 = Dice3 then goto [Full345]πgoto [Full123]ππ[Full123]πif Dice1 <> Dice2 then goto [NoFull]πif Dice1 <> Dice3 then goto [NoFull]πgoto [OKFull]ππ[Full124]πif Dice1 <> Dice2 then goto [NoFull]πif Dice1 <> Dice4 then goto [NoFull]πgoto [OKFull]ππ[Full125]πif Dice1 <> Dice2 then goto [NoFull]πif Dice1 <> Dice5 then goto [NoFull]πgoto [OKFull]ππ[Full134]πif Dice1 <> Dice3 then goto [NoFull]πif Dice1 <> Dice4 then goto [NoFull]πgoto [OKFull]ππ[Full135]πif Dice1 <> Dice3 then goto [NoFull]πif Dice1 <> Dice5 then goto [NoFull]πgoto [OKFull]ππ[Full145]πif Dice1 <> Dice4 then goto [NoFull]πif Dice1 <> Dice5 then goto [NoFull]πgoto [OKFull]ππ[Full234]πif Dice2 <> Dice3 then goto [NoFull]πif Dice2 <> Dice4 then goto [NoFull]πgoto [OKFull]ππ[Full235]πif Dice2 <> Dice3 then goto [NoFull]πif Dice2 <> Dice5 then goto [NoFull]πgoto [OKFull]ππ[Full245]πif Dice2 <> Dice4 then goto [NoFull]πif Dice2 <> Dice5 then goto [NoFull]πgoto [OKFull]ππ[Full345]πif Dice3 <> Dice4 then goto [NoFull]πif Dice3 <> Dice5 then goto [NoFull]πgoto [OKFull]πππ[OKFull]πlet FullScore = FullScore + 25πprint "That turn you won ";FullScore;" points."πinput "Press Enter to continue";enter7πgoto [RollDice]ππ[LowStraight]πlet LowCount = LowCount + 1πif LowCount > 1 then goto [AlreadyChosen]πlet Dicenumbers$ = "";Dice1;"";Dice2;"";Dice3;"";Dice4;"";Dice5;""πif Dice1 = Dice2 then let Dicenumbers$ = π"";Dice1;"";Dice3;"";Dice4;"";Dice5;""πif Dice1 = Dice3 then let Dicenumbers$ = π"";Dice1;"";Dice2;"";Dice4;"";Dice5;""πif Dice1 = Dice4 then let Dicenumbers$ = π"";Dice1;"";Dice2;"";Dice3;"";Dice5;""πif Dice1 = Dice5 then let Dicenumbers$ = π"";Dice1;"";Dice2;"";Dice3;"";Dice4;""πif Dice2 = Dice3 then let Dicenumbers$ = π"";Dice1;"";Dice3;"";Dice4;"";Dice5;""πif Dice2 = Dice4 then let Dicenumbers$ = π"";Dice1;"";Dice3;"";Dice4;"";Dice5;""πif Dice2 = Dice5 then let Dicenumbers$ = π"";Dice1;"";Dice3;"";Dice4;"";Dice5;""πif Dice3 = Dice4 then let Dicenumbers$ = π"";Dice1;"";Dice2;"";Dice4;"";Dice5;""πif Dice3 = Dice5 then let Dicenumbers$ = π"";Dice1;"";Dice2;"";Dice4;"";Dice5;""πif Dice4 = Dice5 then let Dicenumbers$ = π"";Dice1;"";Dice2;"";Dice3;"";Dice5;""πif instr(Dicenumbers$,"1234") > 0 then goto [OKLow]πif instr(Dicenumbers$,"1243") > 0 then goto [OKLow]πif instr(Dicenumbers$,"1324") > 0 then goto [OKLow]πif instr(Dicenumbers$,"1342") > 0 then goto [OKLow]πif instr(Dicenumbers$,"1432") > 0 then goto [OKLow]πif instr(Dicenumbers$,"1423") > 0 then goto [OKLow]πif instr(Dicenumbers$,"2341") > 0 then goto [OKLow]πif instr(Dicenumbers$,"2314") > 0 then goto [OKLow]πif instr(Dicenumbers$,"2413") > 0 then goto [OKLow]πif instr(Dicenumbers$,"2431") > 0 then goto [OKLow]πif instr(Dicenumbers$,"2134") > 0 then goto [OKLow]πif instr(Dicenumbers$,"2143") > 0 then goto [OKLow]πif instr(Dicenumbers$,"3412") > 0 then goto [OKLow]πif instr(Dicenumbers$,"3421") > 0 then goto [OKLow]πif instr(Dicenumbers$,"3214") > 0 then goto [OKLow]πif instr(Dicenumbers$,"3241") > 0 then goto [OKLow]πif instr(Dicenumbers$,"3142") > 0 then goto [OKLow]πif instr(Dicenumbers$,"3124") > 0 then goto [OKLow]πif instr(Dicenumbers$,"4123") > 0 then goto [OKLow]πif instr(Dicenumbers$,"4132") > 0 then goto [OKLow]πif instr(Dicenumbers$,"4321") > 0 then goto [OKLow]πif instr(Dicenumbers$,"4312") > 0 then goto [OKLow]πif instr(Dicenumbers$,"4231") > 0 then goto [OKLow]πif instr(Dicenumbers$,"4213") > 0 then goto [OKLow]πif instr(Dicenumbers$,"2345") > 0 then goto [OKLow]πif instr(Dicenumbers$,"2354") > 0 then goto [OKLow]πif instr(Dicenumbers$,"2453") > 0 then goto [OKLow]πif instr(Dicenumbers$,"2435") > 0 then goto [OKLow]πif instr(Dicenumbers$,"2543") > 0 then goto [OKLow]πif instr(Dicenumbers$,"2534") > 0 then goto [OKLow]πif instr(Dicenumbers$,"3452") > 0 then goto [OKLow]πif instr(Dicenumbers$,"3425") > 0 then goto [OKLow]πif instr(Dicenumbers$,"3254") > 0 then goto [OKLow]πif instr(Dicenumbers$,"3245") > 0 then goto [OKLow]πif instr(Dicenumbers$,"3542") > 0 then goto [OKLow]πif instr(Dicenumbers$,"3524") > 0 then goto [OKLow]πif instr(Dicenumbers$,"4523") > 0 then goto [OKLow]πif instr(Dicenumbers$,"4532") > 0 then goto [OKLow]πif instr(Dicenumbers$,"4235") > 0 then goto [OKLow]πif instr(Dicenumbers$,"4253") > 0 then goto [OKLow]πif instr(Dicenumbers$,"4325") > 0 then goto [OKLow]πif instr(Dicenumbers$,"4352") > 0 then goto [OKLow]πif instr(Dicenumbers$,"5234") > 0 then goto [OKLow]πif instr(Dicenumbers$,"5243") > 0 then goto [OKLow]πif instr(Dicenumbers$,"5342") > 0 then goto [OKLow]πif instr(Dicenumbers$,"5324") > 0 then goto [OKLow]πif instr(Dicenumbers$,"5423") > 0 then goto [OKLow]πif instr(Dicenumbers$,"5432") > 0 then goto [OKLow]πif instr(Dicenumbers$,"3456") > 0 then goto [OKLow]πif instr(Dicenumbers$,"3465") > 0 then goto [OKLow]πif instr(Dicenumbers$,"3564") > 0 then goto [OKLow]πif instr(Dicenumbers$,"3546") > 0 then goto [OKLow]πif instr(Dicenumbers$,"3645") > 0 then goto [OKLow]πif instr(Dicenumbers$,"3654") > 0 then goto [OKLow]πif instr(Dicenumbers$,"4563") > 0 then goto [OKLow]πif instr(Dicenumbers$,"4536") > 0 then goto [OKLow]πif instr(Dicenumbers$,"4365") > 0 then goto [OKLow]πif instr(Dicenumbers$,"4356") > 0 then goto [OKLow]πif instr(Dicenumbers$,"4653") > 0 then goto [OKLow]πif instr(Dicenumbers$,"4635") > 0 then goto [OKLow]πif instr(Dicenumbers$,"5634") > 0 then goto [OKLow]πif instr(Dicenumbers$,"5643") > 0 then goto [OKLow]πif instr(Dicenumbers$,"5436") > 0 then goto [OKLow]πif instr(Dicenumbers$,"5463") > 0 then goto [OKLow]πif instr(Dicenumbers$,"5364") > 0 then goto [OKLow]πif instr(Dicenumbers$,"5346") > 0 then goto [OKLow]πif instr(Dicenumbers$,"6345") > 0 then goto [OKLow]πif instr(Dicenumbers$,"6354") > 0 then goto [OKLow]πif instr(Dicenumbers$,"6453") > 0 then goto [OKLow]πif instr(Dicenumbers$,"6435") > 0 then goto [OKLow]πif instr(Dicenumbers$,"6543") > 0 then goto [OKLow]πif instr(Dicenumbers$,"6534") > 0 then goto [OKLow]ππ[NoLow]πprint "Sorry, you don't have a Low Straight."πprint "Try again."πprint ""πgoto [ChooseScore]ππ[OKLow]πlet LowScore = LowScore + 30πprint "OK. That turn you won ";LowScore;" points."πinput "Press Enter to continue";enter8πgoto [RollDice]ππ[HighStraight]πlet HighCount = HighCount + 1πlet highScore = 0πif HighCount > 1 then goto [AlreadyChosen]πif Dice1 = Dice2 then goto [NoHigh]πif Dice1 = Dice3 then goto [NoHigh]πif Dice1 = Dice4 then goto [NoHigh]πif Dice1 = Dice5 then goto [NoHigh]πif Dice2 = Dice3 then goto [NoHigh]πif Dice2 = Dice4 then goto [NoHigh]πif Dice2 = Dice5 then goto [NoHigh]πif Dice3 = Dice4 then goto [NoHigh]πif Dice3 = Dice5 then goto [NoHigh]πif Dice4 = Dice5 then goto [NoHigh]πgoto [OKHigh]ππ[NoHigh]πprint "Sorry, you don't have a High Straight."πprint "Try again."πgoto [ChooseScore]ππ[OKHigh]πlet highScore = highScore + 40πprint "OK. that turn you won ";highScore;" points."πinput "Press Enter to continue";enter9πgoto [RollDice]ππ[Yahtzee]πif instr("11111",Dicenumbers$) > 0 then goto [OKYahtzee]πif instr("22222",Dicenumbers$) > 0 then goto [OKYahtzee]πif instr("33333",Dicenumbers$) > 0 then goto [OKYahtzee]πif instr("44444",Dicenumbers$) > 0 then goto [OKYahtzee]πif instr("55555",Dicenumbers$) > 0 then goto [OKYahtzee]πif instr("66666",Dicenumbers$) > 0 then goto [OKYahtzee]πgoto [NoYahtzee]ππ[NoYahtzee]πprint "Sorry, you don't have a Yahtzee."πprint "Try again."πgoto [ChooseScore]ππ[OKYahtzee]πlet YahtzeeCount = YahtzeeCount + 1πlet Yahtzeescore = 0πif YahtzeeCount = 1 then let Yahtzeescore = Yahtzeescore + 50πif YahtzeeCount = 2 then let Yahtzeescore = Yahtzeescore + 50πif YahtzeeCount = 3 then let Yahtzeescore = Yahtzeescore + 100πif YahtzeeCount = 4 then let Yahtzeescore = Yahtzeescore + 100πprint "Congratulations, you got a Yahtzee!"πprint "You've just won yourself 50 points!"πinput "Press Enter to continue";enter10πgoto [RollDice]ππ[Chance]πlet ChanceCount = ChanceCount + 1πif ChanceCount > 1 then goto [AlreadyChosen]πlet DiceSum = Dice1 + Dice2 + Dice3 + Dice4 + Dice5πprint "OK. You've just won yourself ";DiceSum;" points."πinput "Press Enter to continue";enter11πgoto [RollDice]ππ[AlreadyChosen]πprint "Sorry, you've already used that score possibilty."πprint "Try again."πgoto [ChooseScore]ππ[Reroll]πlet Reroll = Reroll + 1πif Reroll > 2 then goto [TooManyRerolls]πinput "Do you want to reroll Dice 1?";redo1$πinput "Do you want to reroll Dice 2?";redo2$πinput "Do you want to reroll Dice 3?";redo3$πinput "Do you want to reroll Dice 4?";redo4$πinput "Do you want to reroll Dice 5?";redo5$πif instr("YESyesYes",redo1$) > 0 then let Dice1 = int(rnd(1)*6)+1πif instr("YESyesYes",redo2$) > 0 then let Dice2 = int(rnd(1)*6)+1πif instr("YESyesYes",redo3$) > 0 then let Dice3 = int(rnd(1)*6)+1πif instr("YESyesYes",redo4$) > 0 then let Dice4 = int(rnd(1)*6)+1πif instr("YESyesYes",redo5$) > 0 then let Dice5 = int(rnd(1)*6)+1πgoto [Choose]ππ[TooManyRerolls]πprint "Sorry, you've already had two rerolls."πinput "Press Enter to continue.";enter12πgoto [Choose]ππ[Help]πprint "OK. This is a list of all the scoring possibilities and how many"πprint "points each one gives you:"πprint ""πprint "'Aces' counts how many ones there are, and gives you that number in points."πprint ""πprint "'Twos' counts how many twos there are, and gives you double that number in points."πprint ""πprint "'Threes' counts how many threes there are, and gives you three times that number in points."πprint ""πprint "'Fours' counts how many fours there are, and gives you four times that number in points."πprint ""πprint "'Fives' counts how many fives there are, and gives you five times that number in points."πprint ""πprint "'Sixes' counts how many sixes there are, and gives you six times that number in points."πprint ""πprint "'3 Of A Kind' checks to see if you have 3 (or more) of one number, and then gives you"πprint "the total of all the dice in points."πprint ""πprint "'4 Of A Kind' checks to see if you have 4 (or more) of one number, and then gives you"πprint "the total of all the dice in points."πprint ""πprint "'Full House' checks to see if you have a '3 Of A Kind' and a pair, and then gives you"πprint "25 points"πprint ""πprint "Low Straight' checks to see if you have a run, or straight, of at least 4, and then gives"πprint "you 30 points."πprint ""πprint "'High Straight' checks to see if you have a run, or straight, of 5, and then gives"πprint "you 40 points."πprint ""πprint "'Yahtzee' checks to see if all dice are the same, and then gives you 50 points"πprint "(for each Yahtzee after the first, you get twice as much as the last, until your 4th)."πprint ""πprint "'Chance' gives you the sum of all the dice in points."πprint ""πinput "Press Enter to continue.";enter13πgoto [ChooseScore]ππ[Bonus]πlet uptotal = acestotal + twostotal + threestotal + fourstotal + fivestotal + sixestotalπif uptotal < 63 then goto [Totals]πprint "Since you have over 62 points in the Upper Section (Aces+Twos+Threes+Fours+Fives+Sixes), "πprint "you get a bonus of 35 points!"πlet bonus = bonus + 35πgoto [Totals]ππ[Totals]πlet gtotal = bonus + acestotal + twostotal + threestotal + fourstotal + fivestotal + sixestotal + threescore + fourscore + FullScore + LowScore + highScore + Yatzeescore + DiceSumπclsπprint "Your Grand Total is ";gtotal;"!"πinput "Press Enter to continue.";enter99πgoto [End]ππ[End]πclsπprint "BYE!"πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint "Liberty Yahtzee - 1996 SugdenSoft"πendπππ[Rules]πclsπprint "OK, this is how it works:"πprint "5 dice are rolled, and you get a choice for how you want to use them."πprint "The more difficult to get, the more points it's worth."πprint "You also get two rerolls if you want to reroll some or all of your dice."πprint ""πprint "The best score possible is to get a Yahtzee. It requires all of your dice to "πprint "be the same, such as having 5 sixes."πprint "It is very difficult to get, and you get 50 points if you can get one."πprint "A Yahtzee is the only scoring possibility that you are allowed to use more than once."πprint ""πprint "If you want more help, say yes when you are asked later on if you want help."πprint ""πinput "Press Enter to continue.";enter17πgoto [RollDice]πJoe Lawrence                   PALETTE LIBRARY                [e-mail]      08-27-96 (14:14)       QB, PDS                770 50950    PAL.BAS     DEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"PAL.ZIP",4^6:Z&=37995:?STRING$(50,177);πU"%up()%9%%%I-%r?%:FQW+v'o*%%%K5%%%0%#%%j'%fruq%jSgfOxV&<,>[]5iw-πU"xx80[SbVW]kyc&/mpqPT-^[[uyQrfl-KBCr1'>jQA[X*gPn*#HFeh7Dvt_CK%#hπU"hH5_Phj[xu9tZ1EhNBG;,w%mLyN5dWDZDZ6w<G_hR>F6=L;m,0q2=cS,hRvO'XIπU"MuNr^7aXa^g-^>0x&:7>ILy9(wYmh<S7ihGY#ctCVB\>]5K$sa_av'BUK'e0v40πU"L'-36[EU#LFzo%\''6C.xuAQ3\i;E4_f6A9uZUYxO-eX-0Wv5Z/(MUrsw0CD:eHπU"ngQV6\R>o.mz($Jm#]_$ugJl?;50/_WfB+ht_lRxBc^M(>RdG^obyArZLlvV#L,πU"j:Y?ljkeGSe3YClJG6L7E8QGgxs$)p5K2'?tJfJ9g'^M'P,'Y5mo+Y\0u/etW=AπU"v/z>IDC0Zp^9;eR&_&j'D0-=X4bollRE%8JqN7gqWi_6.dAJu*VMU3OYVz3q#B\πU"OXWjDZu*p#E39--q5LHjeI#Rtx8L9S]WPT]&C&PY&-i5(VJnPybD+P*zOw^et%_πU"vTIo3a&.j9K/qs4vWE_R%<o2dfq%C]VY)0OY7&>Y>d-e4-6*8pui_5Y_#FnNnQ/πU"*I$ihndFbIdvq0DjKEK2lo5g#*Fa*pS//mab5*TJ/Te?R^jse&[M22S:x>1d8UZπU"qyN+4F$oq'R0[IYyX<Sr,L)i#8=%&JG;pK+PDmMk.\tbmSrLn<]7KU<zlB:6PE/πU"3<1?F02h1#.<K9(.$-QZ&t0tiGsw2Iddc'ZD91d(bj5Z9\;CR*/jy6j8I#,&-ZGπU"d[rkfL&GJIVI3*W<Z5;=2B3Jgc(z[J*$DtuR)hxc7:v<\6*f\,4mHLD2qji.CjNπU"taiFu=.z[n>RPjY(pd1spSkq;Zg0&ZJywR%uwxR%/9+1mGpw*,OiEDxeIoK(z$DπU"Sv5_8V_nv-?xDxF<?1b3<ak%HEVTlyr-_$dp<^%K[KeG<8zUJ_G&2N7t-5g2TcWπU"+xP,$oQCxOOAGASwJk+,-=YWC?trj)%n6WliFCH+,5J*RX+GtvZ3Kl^dcbjvw#tπU"BQ0vEWZCm&\8M#Xfrg8h+nr.r=_OZ2qgV?1Q?ijH4xWysw+,[?sC<I3ZwKj:ujjπU"jm^:a-7zP\&A.Cu_/>9qth1f;*EMkOb6Mc_\=+M>>*'YiyR9a$1>4*gfg/LK(*kπU"2J[^ymrcG-4YcQu&l<cP>=Ct4'eF9bYFHWo&ZmR<02)IO5kekk4s(gIbruQ)*<0πU"jiYsSmt-C<h&v&bJPYG?PgG%ES<_b4J>\zN3Jv]$>3$aG/0f8j^w'-50Y>Qg'<vπU"9>,nIjzhV9zRluYe0'na0(_uMsB.0ZxUWX6T-G7=ohHHm0d'_1IX,OXLisT8X+_πU"WA7LZ30N];J/O<FIe'MX<%GtbW&Z-GiQd6WO9wB3,.'95D:biNJq,rf)\MGaIcgπU"n.2p4*bdJyalhRe6u_p4X56W7wknmK#ORM\ta[l6#1tMDfnV0.r[oH$&l?wai0>πU"&=_fB/O$SqeO^Yq9&&5r)hw^KcU,eH-O-P%H7*AO&Z)0-5LVM<44L4Lb=?^=pSEπU"4IZBFV2be3RyAUV#<kupb/rDD=9^fv_gZ_><*ahC4\t8D]xYg,m0t<:'eCcZY:IπU"wgKx$UJlEtKF,Pi5I;\8uq[JKoKd*xiCAFsOk-duSMNq326;obhS3.-D#5\F5x&πU".u6U3Fwy,CG=q(o=':8e$Mq4W?SAnh\EvVS8AZq*,N(u%p()9%%%%-.%ha8.FP-πU"G%?<K%7%kk%%%,%%%%ufq%SvqgHfT.+7yzxdTiXTl%66m09D1#J%XZyu[X.4d(MπU"Y]W(/i+G:1W+*U(5rg)U4_oLb)%2h^^5R_-eR1+91I-CBBNB&8vX*BjFH*mYD_xπU"Z2D9;=qotbu8xdpYNvh&WXk4kbJGb$3gF5KfW\,*hUcxnI/$1,d5FlpSFF2,%g-πU"F/:WO%0.?/rE4/?P6Gu:Qg7(jiE^QULY(NG3[<9z)*COp?9BZEARFxI%fEYFEY&πU"Df_-)Qjf4C(/M[&QM=,^kg+,\/39:gh/Rfo)#cY1UkOXe?&)YdOMdd5Quo4PS:7πU"W5Pj_16p:+M2UV/*HQYjG+B/hBCAU8?%+Se0/+*t/f^h&a1&L/EPS:7W5Pj_1QpπU":;g=0>i5#a/P/+Z5%T<:jicreS6iC>K&.<<(1-GfZ?wlNdQu9Zka.*v/U1)VJF3πU"^70/E8SQA(I0QStK)7mUF<YJG78yQk#&5),.F=I'(lm3/-#WW/[GF+?#gGqU^9gπU"&,K91Bp75Q)%%;f^a1&z/Z[a0T9FkQ1>99;q%]/h:e5Tv?%b]9VqX+G9H;7PXeSπU"tE]%(-R)m)P(u+)Z/JM:n%IdD$M%JKZ%kT,51+fRoggO'4F?we0[c;(/GC[K<;wπU"PcHZY-JOgT2X/s9/#=(kg1*B0.r%Sn)1:yp3[shHuU&,NS*mUf51(X_+,4i]aX*πU"(9J0iVK3]Xh8uC#QYS<mO:5.*8/;3EPKM;UVYVn'&H9a$)4G?:8Z+)]_5=:%29%πU"[xE,w:+:YZVwSV?=1G9J:u:*2#E17/:_3;'n'/H<cTiVM9:<I)(dRkl7mUU3+h9πU"%kAg2;'7/:iWq;PViL:kT5EICGsO0mQ$.54bE:#YYvu):di=cM<v#]2dR3O^_eTπU"a2<0%1=F0^/0N%YS8<)n'4(:cT)2cKZ1+O0XFoX#F\hNMWS#_:'T)%k%:5Q:'JZπU"$\7'$m6i#AU%?wE8c_<?Qm%D9#f)#9Y\B]&X<:Hq.&M(j<7g]a+-0:BUj)gT*/_πU"'(u%'pE1?##\mhnTN;cDi&e^&+SAH$iJK4,F?*SC&Q=e?$S<CMg-hIu/ZpX'O::πU"Ti6eV((?9s9<^q.EwOCPbSU(B\_4:iO?eTBYo=.z+0U)bSo<mR&JE.wIE2ApI%CπU"T49i95%)j0Py.gZK/417SXJ?CMSED?*)bP4*)<e.='rE13a/+EEQ^_:4ti\\πU"'&t;^KG:/K;swTFhi(+VSnY&o)h$',SU-(J/=[S(-W(HLqVKg.400.$%Tri1O;PπU"4&/$yfd2AU(\o.S:UDogU9v8mU%1GE6Cw0;g&0Sa'sPZh)X;O<:Ki[;RFtZUk;QπU"BI'0PeLH4Fw?(*mT&U%9GE/[qU(E[U4oZCF'+N;VD).H/93w2R2?CMMPzo05.DeπU"b&a.6%F9kfI1qQhe_(4)=9O9k'Q1DfC:K/.?;pI-Fd;T/2VO/g)=P&U=7[:)EL/πU";3#h>QTa:i9%8T2i3q;Vvig:kRD\?*'32r./I)[PimAVAMTFLYN'14*0,reV(YaπU"1u+],5u,bKU.2/IAqU;eG%e;-,i_y.f2K+GVY]k8Tkq>sY0YQ,QgU=&Uh1IRg/EπU"R.wMV/SG3WQFoQ,.9:^q2/cb?c>TTZS\oU*Keo-e:)9G*c&Pbu4a,ZpqR+?Y.boπU"5:P+[12+0<=g%,hi%Q>P.i[EeOH?^?M''4L'6U1-10W&3e>y99_Q/H4Y5kVR%aKπU"+#/41DR7mP^'G=O09kG<uo:0I7)OUsTX%607II:1^MPJiGFQ1n.ebK41dPq<'GRπU"5/16/Q1AG%CVcni+e/Ph??)MT%b-'053]JU>+J06'0a8504]YMY<=DI&\KO6UP4πU"&K/C(QOju13z/R'5(D&;R2I18&eN,9#BU&?X[3V+)b=m)P(u-$D/Z5.'$0<EeRhπU"?s+G<hkoaZfL)PoV]TF9;NZ-WU_3g&,#E<//dcQS#S/R%RGfYZGI4cQ9fq9];DFπU"?.M_P%unH<r(=8OCI04+9,U%7GE/D[_+B0Z&'-QDY(GI>cQrKiBkTZYT*,8/MU(πU"$\0OU+,,FDPYZ0'=*H9d0YzG0gcQ9q+;GfPQasr>&/5ifIaqS8n?d]9^''*H99KπU"q5GyZ%khPNPk73guEL5=SmA?,1UB4F35[eK9<)A'(T9;[Q0H#ZYk8RKq>&)fZ%9πU"$4a*'Z5&.mU8+:7't9?AG6cSUtO:(h7UN<2\Fq17=3pg%Y=E.\uh?]-;<u&$HO2πU"W2O^0DuM<PiLH+P%]a[5T+*mU%*gQU=+2jUCEgV7'R,T:JBi.AOc\I-899zaXF-πU"T=q7E.KER<;92o)'O<\Ju,X094?*R',\k122/AEES7w;OfYBfQ(.:;^o50BT2g/πU"%]IfKH]<7GX3/;MBq'?p.:yp]\ffUU+/*U6Cw/3'0YVG/4[;*u1*J0dpAQ(ZaYuπU"'wOh)Lo%4iea&gEDCYS#Zn0i?K1FlZ9+PU9p'[,='\mF*_;H\)+-/Pb?5G]:\?7πU"+S9T/?:=>DUB<[/SMg/],E#_%f6a-H^i);&Oo]-b.;*qF\U?U*nOM=.,N_0FJ))πU"m8P2i&nK($ZR7M<#3WT-U.5G/Q^qVYA/PG'%5ZY#cgdml4.gU[E+[N==C,bfvU=πU"tcr(At?-A0U?18/aQza[NS.Frn*U0hw\wUrUb_j2Hxq$rryp\xV1(&OwXo.Z.ueπU"%E\/t,cfV$KX=lwl$\XiW<DT:loNWLZnZ/vQrm/\:x5^7t1T&)kxw.uEL7z><\WπU"fc[WoA(:ya?^MYvS0/:>6DjcgOJAI1x\'OH$36OQyUc68ZIOcUiEj^oOBo1a&>gπU"VHHCttwOg\yh,eQ<f4f8\s2znD,%4/;_tr3>U^a_&20;P_n'Go.6rUVY-W,_wiTπU"[Cw*6ye2gdo0+;fn)mD.>H(8[3ip).rFC.lT9;YH?Z>%P.LJn.yNL97(b=1AR%oπU"CvZt%-/p2GtQ=irT+3cTaYCi(TD0,r30s]N^;nrOpg>gol9m?aKdRuS2pUU0FmoπU"uJ,x'N0Gvm4grETnLwRcacJlr\EDb\>%1MX?g>xn$xGyY0Kd=zs]s#68]ddJJ^oπU"kIp.,QqDkGK96Xlk_XqQ2+Y]E^P4B]=$$Y+3&=3,0DFT',UW-ON?a^c%8YzTr,rπU"vM4Q1L4kR^-&mj^yCTGCdDo#Ps*v5YjGrcJsG\&s9f##n,oKjC^8gVf$IdZkAT1πU"nP<lbiQ><f.<r50blBpH%0rdMCG:o]^SHs6m;BmHZftTnlSibHHe-K.P=>K$/E3πU"kFt%Bl]lY-t0KV]cH$6x8lHmT7($fA$dT>cG$mc-dL#I^wVLQC6,Z[]z<p^8iy.πU"Q0LXJQWoeHsb1V,R$ZEDkUn^wN^cqTrVWTCEM7N8q.N0G%8;H0'6Sk_e-qD%l&7πU"jUI;iRK]OMRC6PbDvjD.qjb<N+4ORDF[*HIB0Kl:J.oQv,DL3r=deE=lt[jzRfpπU"UE>/^%vB?k-_6TkWM'RCw29Vq;.[(XjNqgQ-qzGPm+-1+HM#d]%64-QJt(si&n?πU"A>#P=h^3:E]%;ss$sm&-<D8f#))sIS$THNXrg95-k[cxRE2;=Na=fND2s<r6ts2πU"[3WZ/bu.bJR*P77]Gyfbl[/r,SH\tcLJ3Nb]A+L;C(2f0G,PiQ<u#(?*2<6qfAFπU"$;?6TY45V#QF+yfm#?)>Z&c?Cr[G7k\F$w&mnRG#oF*$VjVbapG(uC2Y7g8+id%πU"L<UGjL=MobERf>/f#?6ickYbm-V<:?#>Z=Hc>[bcMb<kPozJ;dl1$x[-U,PH_9#πU"8yNf:4W01cf0yulegg6duVph-j7LpLz\VtgbE$GBSjQ%>)?bWKiLTY1>+ZRSB9DπU"D4y%GUfrOfH]jX/']]0CPVF&X9C9KX8&Nc8\bJ\=(stqA:MFEZGO1g=D%bUNdh#πU"b2[sJPf))P;HSJVH&hkXdeVY=%M2ZpfewMQn9j\OHVRU=-vKZ+Jop'1#4F><,rBπU"EKep;S<JRAgz]vte0wDvT'P4fHdE[TWDD_NS9b#ZMJ-2sYq\e<.:P+OZ?2Z'8JJπU"/:2'q>Z89cYY3*_Gd$TAKTj=7o74SF7P*;IBj;w]vn:FUdM4)4plaN'LqHTeBEbπU"[lNX?l5x^*b?(OGlt6VTxhKHpn'Nep3%.8<v=T5r#DVfMMwr(Eu8wit&R.Oq7ZiπU"J*ITBZ6M.(P_+jz<_L'HnF&8hsdoR#24O2.AqU1hdTEDh,\tp'Cd]EeWgjyt4sxπU"0/&#KvQINJ8\sA9#\y$0T^&q$?C#gN>__GO\?8=Tlx42,B*_-1__SmwRW'Y/FW6πU"VY&)ZTf2n#t:)[(9&K'g:Re<Bi%:R(Gzf^.Y&T,=fp,6qLrmw?rf2#vr:xxcWvPπU"DQXS6d%qs:h3ZFe1Ffx,%)H:P/m6l.QsD,9Zk?[plx(6UX]LA.:DW7Pr%i5PHE;πU"#P5Y6AI?eL]UQX9)DYE5$oVP8;iS.fe81?K_fUB#cWC<NDG#_QZ%^[,VTW_k%k*πU"%q3$6f.GP3BG$o>Zgit]*V)MeqV2;(r+1*r,0>[LQ3/X\U&KKcpne*i$'*xCT)iπU"sLn,3%:WtIFNwM+ZKJs$G$mt7CPE2U6n5?P7&3%q_O[,p&]qX_eU]H/7]WT7=^GπU"JC1?N47ibsFyPa=L&.BIu4_o]_wdC*L(==>lf^]sc=ln+5<jmc1;FLJl^o?R;%QπU"Wl7.ShfWU-SHr'cL4O((fy9/_jOVn\WDsB(r5o7pisuC9pd=)h(2-57Gm794E?XπU"(7K(521sE\z1R?(zUpk6ThF5Wk6('?x_0rZhuso2.<WvtI<]^/+YZ-YfNo(T;X%πU"BUsti/oca>bjv.A)Oy3aC&?f;O)?jPQ6h2WwkwTB3DBLHt]sycd_BjPOl$*W+bRπU"bsHNjd2scsMcd_BjP/E<264j,LlT.\sytc\,c0<212CnZmfltggU7_3xcGM6L=BπU"*>Ab;>$S$VuV27t>ss-c3dBjPYed*Wr+RbG$n4nnrbKO$m[<DdbX$GCL3uzTNb1πU"LHLwLlKHO$[&;;V#G^wLCL5lpfWAxcdn?n2F:6dl'iES.auO$0>$Ly.6n?n2F:6πU"Dn'iV9n#Cu$fp1pyn8HZsU_Y*nHQG]fTCL5lT&FZNP>6hL=B>)EGQGWnv#C-$obπU"LoN<Y,Xc021/LCZm$nHq$fd0ac/JvyTNI6L=5B>Ab[;v/^eIsFSjd>]]JnkB#>tπU".&wf/daoa8hq/rPw=t?dftz1<Vm:]h%9;g,H>Ou35Eo1cf.2e>>]-S6u0.0D#nLπU"+S(LBOzY-q?%>v_$hGL$qi&1broaVb=b3t'b9(01k+xt0mr\kP3xhETd\*V=Sj'πU"TuS=wP=tK8?j?U;PK-eOSB#Rq2_;u5l8ac:(s6Y/&>O2Kg_4tdctVkLJ:?_os'\πU"lpC6NXHEqiD'iD?Q;vcV:D&6Q.DqN]+3TvqdapsCMHslllQRG52/D/Hbj=FTb<TπU">oUT[RHqf_v<2$/DLU+E%VITjM;\qv:N?I#?'t.:cX18Q6Gf^4#8JD8=K/,2&>sπU"480X]_Wz<<\X^JrR,gqQnaMa=G)[5MiQU;HdZQnkVS7E9>ASAK4^%Q-??YHHuRNπU"+,rZdACG5NY]jpatv)E0KiZkO&2k#BuQoJ<1vMn$=O7Zqqd-QYq\aFe<a($(L?^πU"4juW(jko?IUn:B7^s,C[cGGCGb9:a[)6FbTC#s]PtPh&,.x3Yg,i*5lNAYn$2N6πU"ghK[oi[8vp]DDZil29Zg=k>pkA8,\-*7t^nL+]^TL_tWlduwGpZrhHWb+lEiq70πU"g'i#?BB5yiBhmBH\WOM?C;;Oddh6IH(lalcbTf.G:u,Kwm\ZLKPPfV7%OtXnx?wπU"XVob-'lxXp3oG<dnfVS6bogX2=b*eUSLDthiWMT.<iE?uB/\k7W-:r4F)Hp*SPfπU"sCVe5;W:lwrem(SkL-D8?C^tpiKJuD>7l,OgljDuSs;wbL[D2-HTM%znNi9tsZTπU"j<s6>qkCVdZ3#,d]p9h.Z8<(CbAe&Pl\4K4C#NGGGDXFF:&>JUXSACUpK?\Zu.;πU"5h8zgBPzJ=[7g)80Z=ZicJwhY0%?k?/N)CQ<B,+?M]wNP0VN=DLS\#gShS<WHnXπU"S;fk8I756q-ix(fd1\j_\<ZOTIW#-etk7ZGnUM+sSF7>4?pP-AhS-ft$c^&/jliπU"kw<*j#JOO>a%X31SJRZG#\.NbsT-7$Nsd'Nn0$9aIp/iw*l-E)rsAZ(>^sDDXdyπU"4TZ2.QmjY:q]fLuc=_-<\4qq8l_^\b+L'LT3ZOE$7eOrf9#,ApFAXU9kkdE=VImπU"ek/^7>L9a3$^#DLsv&zj:BMLcJRNd&USY^o6Kg(9$X5.ru5lGMNjoDgW7tYmXt3πU"7_6$?'dtghmZ,pEpT_+?mH8TZ]2a.cq7u#s0xbpbTq4?QU'&]]hGagAIDSk6x&ZπU"'feHS6i.rfvH;0isCa-48Pl$;vrfkSJK#8kAHT6SFF/?oq,_WBPDSv>*aCjWvS?πU",Lz?>bflKg]Kzf>tt?uj+,feJNi^/Ut?J;M*3L0*#EC=5'J6VUla'[B6SMe<0WTπU"V0v#fjRf4T'6CX$ab8Y1N6Rr4YvtFoLp-fBWREw_fXC0q=)tF]hJVfg]dcX2nN>πU"BvuE-V#PhB4mEdhn+Fr0Xb3)(Mw0k(VBU(6>P</L,T0/?MV-MxhwQ%0BfYWVi:BπU"6b%8cK(4Wjy7&rmI\)w^n=e6^bCevsyd>?R&/w>A&*d\8nL]2Nau'd\LZbfjn'hπU"UuH$-gjB-zqNY,Ms01cQh$Jn_+MV&2#QtA5a8a_R]uamkIn5GMCeDx'(8#FSh>\πU"ZNdr8p^DOm*M2Z&0oYC-8KtN8)^VQh0uz)n*#wY#k&-V8J1Y?Vv&&MLW%wpN[(bπU"1Spu$,m]gv0Lu.ZBRhhTc/EIqDJpDMEBc71uU[P)NK-#Ab<qndP$b>D-'/)lBeOπU".[TQxUHiF*tc5WV4r_zj?WP9sp&i$bzLloYejlb?^ANO$$*eVl=f+A2z8]2z:27πU"z#2Z(FAP<25>+lME7n9$sLnFdGjwvbusJ4m;P%#jhfFQghEbm=boItrAIk,lc59πU"8)5UKvL>w)y;)usuMh)T.LTMl)&tIrlUxzMs3b/9::licwMzCs82>9dDb8sI.*CπU"nYzDu%*_GupwzSQmLjGxqvLZL_MyR#nLUiMy/Kn3p>H2yjmsH&cfiIOwzI)auLwπU"\zgmLDrxzI?Kq)bE.y489-Eblj?l$m:L\RmU+_?C[I(n\IY$=XdTaSX,Pfup\xsπU"ov&tYmo\>9xmh3GD<HqO?]mxMBkL5l1rVn1jg%%*NBrhF/M*)^0uQQ&8kYD%Ki5πU"yWsy.Q4%PAa#C:uV](1UTs[SdZIOmK;;-%*xL4cTT5dv8R184jWuYx?Q3Ox*Bb#πU"$l.W^dUQ9[_,rln0P&wWa2c991Vk.v%PNw(0L^MLUZH.NlU4*gkiU?dE1U%?lFmπU"rC,lx62N(PF\Y>_NL+RBQlZc%'NNqd.^_K\ELMUrG.%=O1uGZ7_#0Tb&hujt/M6πU"%rfqmRqkT;rwWTD$Z%aI5i'+q[hpztZ-b*6MM(dE<&5%7PnChSI\h*D(k#J3PfWπU"Q(FKTw[G?uoSGneD$(?oRv*'HCXU?5/)bNYPVoc<2NIDZvsb1(VjY<Y8\=U<1;FπU"P?TUfh-)ik'Rz5+n#\(9PEDR6v&^MpLvu5L^<I8FxxviiKB1d-%nX?j_09LQLqAπU"&dCDCa5,n$XkyVJWo>#=3_U6n<D&scd3td:IUoZGEmCPOImmg-Tkqcz;0c,LCh-πU"Lwj'$\o9u(lNoo0+djdLISmu(9HNZ<fabi9<3jrH>%UZ.qLo;Y,\p>N+Opd0y%PπU"P;X&2B&#y*2MTjDn;#']$0Qj4Q?3*DDsX86,>Ss[rrb^:m$nm[F%%g4M:,RY>7LπU"dxsw<w.7;DvrIsVqzOr/4'T*>^2hdyUJZo.[7o<ut,468('ECNy*UZl\dSe;t<sπU"rFLKLyfunnxr#R1%J2i]AqWXr81%k9v)O#jL#u_^?=KjILZ+F7*FSbcaY5dbg(mπU"rVgbqTsNx_VooFOLa?iJbGKk*ZkIIFDD]>aX*ww];]wP?oVAX[t;N'uygRyzOBsπU"f,M;MXdJ\Dq47;2=_$CKgySAKt?;tsBHOU8TR5iY&]69)*o=grbbrd?\qme9pk.πU"X[ui]6\AH2\2HP1bbavd-A(mYe.vJ*(#>K6Z4*p%P*s(:)FkK2;B$8yK#ThBT&NπU"AI9U?ib]c2f694?s6W7utu3Hg%Tr/X\lWJ:^2]7<k)tGQ.sNi.T<j<E>4hft<00πU"k]nA1D.If3QSKpupQ[)Zwn=6#yO7(D>va[V-3m.k[SV9du=54(#f815SRqVLu^pπU"?iTG#K)?jnA==Z-aNwB[9X>f=7:ErV=<6$JU+k<>B-Ga-k.lWI\_rr=6,VJMkJrπU">\0(Ymv()r2>BE#7'rf\>l9/77rk#kLXiiEwXJ%9kx>Yl?aCOkh2C:+r,>EF3YZπU"dvXrR5[G0YYfJ2[EG2Y^BJ'kZg=LOJ&1kp=f.U)Ce7>rlp>,9aE\[S2JCJrzg=LπU"aJ8v=v$Dr:=L5iJ6=t,Da,n[c#aIKk.1*m4k\FXs/r8>Vs[brhWs1Cr*>;LnJ4jπU"=v_JUB[g3eC<r4s>V<aA-kd4eCDraH(H=4e[C/m15rV>=b;avjk81m:=r#>=b:aπU"njk85mR#k84'm$ktgVIiJLX[m20mar<g=<1-,hJ;k;N0m/qr&J\b9I%sHR'(Cc/πU"V43me%US9/be\IfUCVbjZ;a7&bZ[L-P-o>VWI,]sgd1=Bs<BRU%gS&PU-+$<,5cπU"B5dVYFZ</0A,_XY?.:C)dV_ZJ71kl>VLWJVp>,AaKX=LQlJ^['Y/MC7:*rd=VLPπU"JNjU3mJSNW3$BJ<>L5dJ^><vSJO^kz>vYmJ,[6w97(Mr\1LI/kd[A1TiF0qXI()πU"r,>jbjJy-R926d%vY:R7jhJs7Y8&i+HJkY%6Ri('JcY4o&h\I%[Y2R(049lI&3QπU"02[]5Y5QJJ>2\3C1VrcJ'+k\=rD3CGreb=l;Bayk6CWIdr28[uX5i<7F\r4W3,WπU"Jl=>,Ea7dkD4-PkJt[Xc?a9gkn6M-?a+kV.2mDjkX/mRrkX0/C0rDpV)Ba7[k0XπU"5)<7Rbrt>&52mBk74Ws*hr.qhV#sR#t_RJ>YE-U]kuT#=rR#ARV#kR#PoR#siR#πU"wRUl.1f.dDW<GukjMDsC9=+$%N_S+C#de9#u\^szNB(_AK>G62&v9_SO]*^Ahe%πU"oh9ndP>(7Ot6sDRKN:DW1c<6a;H\n$.mMXp8Ga]c41E5:d]nSV=[9Hu2ekc?^c^πU"x,cDv3XS;b8T1KO*nb'%8iVbw-Tqp>c3/+8?e;bpcY(UXIhs1&=V>t3JLgEaa8=πU"r:ghhViq5Nh^lqxiNDHMOhJu)S:6[Sqv1QwUkCu#hW^&_h3^*]_h34^]_hR3^]_πU"[h3^]&_h3^*]_h34^]_hR3^]_[h3^]&_h3^*]_h34^]_hR3^]_[h3^]&_h3^*]_πU"h34^]_hR3^]_[h3^]&_h3^*]_h34^]_hR3^]_[h3^]&_h3^*]_h34^]_hR3^]_[πU"h3^]&_h3^*]_h34^]_hR3^]_[h3^]&_h3^*]_h34^]_hR3^]_[h3^]&_h3^*]_hπU"34^]_hR3^]_[h3^]e_h]x)Dp4dH([x4/cckH%/*F\O.LrqKqdS;tW[A(=ZBJn)#πU"bK7W+g'NY&E(WP)x=_D_.fQ\:,8TQlH^XcmdsX(CJ_w7j+M;5j,AY237<s6*R+uπU"K%Kr:P6$di[^7x4N9kf&C]nHXf.jt>1jH5ZUnxF+/_voFt8.l$W])E*$N3380U'πU"]9BN;;6a9]EHah.j2a*ly]QJSaHd0sxBtYSuU#'0l%<Pe^;$_hVm1g<Mk2#00&RπU"l[P5.<;jpUQ>hAu%dT4?=/Vs,EPsRoBRAJ\^TYd78X_<\j0WFVFca\R>M<QXn2,πU"Z^XY<mNwW_Z9..]wo&c7Eq+o0ERNQFh8RI0ik^x(2pJe[UERt;B&ec#2EE*U':dπU"NG'/LfpjMnn$jGvh\;Y7aIp3s[Q*]lX;aLRTpp_p6(APgvIf/I(W6Lx[pbFgnVTπU"X4c<VGTVg5e2o;*I^H.nMkjd2+C%tW6HP^\1<fg<,3Ue;>2gIv^HU28e:MAd]nxπU"rJD^EF:Hpd0Zun_4qnyvL3k*BzA8fLNW^\yY4B1IPCuW))IPQ2ptCJ*[_ZSvs3SπU"B3XYI1p=0MPMM=;-m7MmTHL%e.u'cIMpn$2dTMQBJHlUoIU7$Hk)=iAsT[6r_iDπU"Emg,an/tj(>(;B.do<W#%:TasX=teHu*vc^>a*lom0QU12NQG5Mp#09T='6vnM-πU"lB.[2H0d*_'QjDrV1hLdNM7,]2UX3Pa:Sa.FQEUD1;iA4;;sY3]^h#<1V5+9H#7πU"%;C;cB]0gynrY]<r3g=a0Q.fzPs3='faUfviX=&-F2Hx[:w4;37W/tr.\W<wcE-πU"nj$L[VLY[jL1q2u>?ItpWh&e5D$>8[=n[nAvP'4Dr\j.xK>/TE1xmNpls15Z1RSπU"9^()4<m)Le#ddob%+j&+yTy/:wxWKYsNc:ROcVvssgHH:ds_0Uv_(s<rvM2c;u0πU"coG\ilANzPSub&cX?hY#$_8Qgr9mkFJd*d,(/X<eDo%6D2&*Xum&rYng^_-HO(\πU"(8Ft[X(bCTs^iYZ;s(gY^7qMCp5bpDn'InS.lPt77i$r#.Iq_BrU7D(BWOFDxebπU"j>=v4gYnD^pxuRMA\tt9XkUAvo$ZXW3EvfZq6IibmZrGf5KC#R4/7kEfgj0us['πU"0Iemfkb[scBB3JPK?]BB:S>f9v]\ctrUrXUjb$v+MOF0$[aTDjNn)&8m&F<?6qgπU"Ft+]VZK3_pHZrrE^+d0owxUJYrumD+A8JY53,_OrB%gd-3lOJlRBTNclbC'Pmi8πU"\;cM?N::KsJf$TsXMAk_ml$uSm^7FiABp,lS1yx,tHqs_:W<)rIW39rBW&aUq\lπU"TqPk:Dm\K#,8dagwvSAhg?t9n<K)58Usrs8Kt.T(/D4b:<'qu^k.(X0L$:9X9KJπEND SUBπSUB V2πU"e)d0w:O<QqtMwLSYH;qIpRx_#k.OYdun'/4u)7T.JkUN^I[Qgn;.vN.T\l-1qNKπU"&&j9knP8=5KD$.^/b+zfHg,yLR;NK/,pt_oMbDTM#o706K6i3FSb5$3tgF?(8fMπU"nwJ+ImxC1O^,sA6_ce-_8XYv=6VTg<3+PljMh8V:;0uDK3<TC6,g>gWsug0aFveπU"0IemzDm[F&Nfn9etOwpQ?<MxA\4_74OSAs$VDr.ji^U=hs;b]h>F:2OtKCs1yLjπU"IZ%.j'TyFr3p8%mLdW[$mrsA2a88A7L3xGYURtM$gmTmY;bL#m8_xGTMMtUNluTπU"2C5v%okQKRC=N38</c_o587cc(Et;N&Luo<+obHw/)StPs_bAlUmnesII[s:VsCπU"&clS)-d)_=5w4gK6<uHD-]V$ClR-_EWXPn_)WIV_#1?u=Qn-?bIBEPT'a/-wcV3πU"8OndUJMSc6mqs]Ict+QS8g[sKa]amtmb-U]=nNjiu/A57F^WY:s)?Y.J_H/VA5]πU"fW]W./o1Y(=8avE4P5Gh&;1h#4HYK6f)_QFNMb0q8B%u)U3,Z?v%V0:j#LrnW.sπU"qW[BjHVX1xbTYp^0e17NnjK_b_>PK8GMA<es=nlB=3/aq^TpGe/n#m.x?>.L$iWπU"[FFVJ1V;Y;*T/mm8Y8+/EN[r]/]pWt\iG3#7t\>k7L/R7Ja7SX&X.VN%MUbb1KHπU"9wqKA+M+HJKxH;QI87ISW5IbZ#YCY5o\.[/R.*LSc#L#2kcFO'8Uarjg7B]nxqkπU"v=rQtQK559E^_q;Cc2E&Z=7q*BbLHdn:aj$;'_s%ZSK8X<DRKDN1]zN)3M$]IFJπU"2#^*>HP1X3c-E<ZbGREsn2igavD+QGTrjMJ*_s.Aw'Es\<1<63:8Z(1^75,k0Q,πU"=PQNKK00NLQKbL^VguRq=#&\>SMD[RSQ9J)jZ:7JI;'YTus3(;*opWE(u/(km*#πU"Z6)%gOD:m'gIteRJ<(50Y$eUQq;#Zuo%a7ak'*tunG.c?15yD1,08nTu/iR[Vs;πU"Qvr+AD)pS]^qS]QBL#mMBZK^.T2Cg%.eDYfW(^/Zo=tMDH)uE:9eVqgQCgxC[)uπU"8__j8<eX_;)U:WhB#M?uU;[oH*U'0%Q$HxoSU>1IVOeUr*()X82)dLI9v_lYj#(πU"bguw_/Lr?cZ(Fxq11:5XX#vx.=umqZ+Z5e5[^Ax'b=5;=W+X8'j+^r]MKq&p0lqπU"D>XZmmKKfe24;2m$mvqkbR75MRH^HK=WMItq^l#9<tSFd[V8AWss^)Zm7Rs1=Y1πU"LpiYrIMkiWfMY03;XW0y+)6Lq1siWhA4wQXJF1/U80/x\5%E3G%wl0.16fY:-w[πU"C2fidmY9O2iDGR*=[6>xG77<H]8S%+0GtOxjQ1b#^maqLL?Rqo=t-Yx%u%p()9%πU"%%%-.%ha8:F5rr%jFK%.%63%%%,%%%%ufq%SqngEFK0/jyNhi/FLbnOK]l_/S5/πU"g%gg7m#KT5H;4aEI/PaUq.=ex=)/Oem[U.&MT[(.SIEpLzIxB:<Y&TS=_*dGd;^πU"E3wjq+Y'#dGj3$&zY>pmxNsYgv7Brgl2p*Gl&pVF,m5oGbpU>B7#^3$Jm$7;,)?πU"me%jXHF\Ft6_CdpAyPO&KSR\C1:&*A5#4r%pC^94kB4B*S(x#itmgWg2DLuJS*$πU"O;';;2ZquigFA*__,gbuY[?C1VkMO*y*/f[&y+[h[%ga%)\>[3hvVOwci[zZR.?πU"OAckjpl132B))Bumd)Om^1.OHc/:EWs#%7MYy=,gz:8,lI(2jL/VpuMtxxtnh?,πU"cB_Kp2\2pr-[zQi[^(*#vi&8u8].3(nM:x]3mdv22ZQ0N0uEF>GDz*?#Z13Oe5tπU"o7in[&nvg,q/<GmkYlA_hJO9a-Zt353[5sk*-v2pJ1GMSn1xoW%\mIg)eeX(=cTπU"(tHNsOTudm+'=l/>$mg*J,gs?A]o6_d=Nk_(tbG*UBdm_IANKX#J8e9JcU\f[w1πU"gw[h>UWbvljqHm7mnT:<^Z0o>LVr7#7Q?83#fK&%Q/-MbHG4dXj'462e?uI$O[uπU"XAN2u6'niATL?1[^x#V[+='6=EenyL5z&>^kKrm74yxCo3,MxbC0e*7$B5>u0b6πU"j00jI8V>ZoiJ=XI2;>]Jf*t-H=)yB##niRi/]$;5Eoi5d$=#sl(000U)VvMAO9PπU"]57Kj?^&^K-xi6C>z%r(15Ccj3'($rGz\1zV&HS-piAE[DZ-uP[^;e:H-VtGnZ.πU"i<x>\MG*j*b:ZrHJ55MI2(/N-ri:rv[&BzfY6^:MPR(qM0=cGAk:fR(Ud.dmlxnπU"#%\#k3N3\>jx?xUW.U)J6tnD*vSm??DqE(r1-.GCu.IG=HRj.7Y:S:SM[a]e(PhπU"kN-%gC?]^^2ul5j[[zi<n.)dCD7B#;C3ij/EX+V+p%CaV-MQ]Tfiato?(bebf3=πU"l/F6#AO$rrJ1FG0%S/M;8*iuxF780>yCMD?Ud;]r5*OPYeVKq6&FxfZ'l4GxpA-πU"l\LFs<Hm$B/)xCd,:O[&<092GE.zSD:'naFQ(Y,\:ddcoe'Z)=Pe^'(%J=Rl+YtπU";2XFZ?jUn#Ubr&K.eHpB7j==EN/bw/+g5o5iT(SfXA=/$V9*)EU*14ek=O2TofyπU"1:V8'f(R&g+]&DC1_XDlK0bvoGi>R/l#?U2YrDsPw?BqA)yM_OiX#ezv<+2O[$-πU"n*CI<mf)fBqXrscn3&TkTr.:[r6DgBtOUhI4-/v$*38#h&0fV47iRT\8fN6eyZ$πU"MoVk5cK77U1/$wb.i;;sM.qOg66MrWe]feKYVi&Fpr&C,V_8G(0Ct2KjpSNjUj/πU";J3B\O]tL>Ax_0CLR?_%8gQndZ+g\Z5>(2$OZj[mLGuRx.w8F-xAy;lV.[_SNNVπU"dQl+P^x0HOk-h[CUF=%]01MWW/mH[c[2[BqCo,>Ud)cHxl\VB:%#fU#F5_qQ&=7πU"g\1B0mr^\&GE?wr67Ej*h<rP0Tdc*oX;*Yl-:'#z5kjAPSj(G[wea>=MRX5pKK(πU"'SS?S03Wf8y5___QH6;nK2N/G2fK;7p-M5R'PnA;5zZyQ,uqOlCQT59uu%2^Q5>πU"$lQ;jaE'3-G0#8C>b[svW:7Q21G0/v<O(Oq_L=)T?SFv>DFs<PmV>Rie>-*R4(IπU"S=qh3Q9Pa1Ra)7:O0O$jTfTMTy$R+YpH.2g7S33>lF/'VqjqECwuXo.0*/Mh=e/πU"$f9O13)EZx/NT<n+,m4eH]W]Wjf>vN;9:._-cZ_tR[-&$T-jr7PZse^?l5X5s5=πU"#V)#;0>CoD?V7K]ndYqGwSNK3lwI%QF',/=80CgFIJEZw3E'1Hnc$#cvT0,Uwd'πU"6d*Z$e'ASZKUO/;8;)]#k&cu+.*Rwb*wlq-2B=\%x,W*.eJl<;VcG6o/0wPG-jdπU">=c#^%NKKyJC+&J1[vbm;KXQs1.^6>;(w#6:Yi))$L/jlU77'rgb3x^NlkxnJs(πU"-^j]vIKn%)u9gJefTXEwXah^t3PN<O2&BNJ$EF*x;cij$t3eTKx.S=53GeCHl0aπU"uj:.xOHsOmco>E2Zh$;_.:V:I*E)5X?x=g;<0dX8F+$1p/c/TS/?S'<rIwwsbi<πU"np=Q7&IL6Cx'/gsTG.QQsg.Z;kyM'POF.E_*-hl-6m3Fm+5d[jTN:a?rt>B#DibπU".3xxst-+o(lMKAFJe,r<u)?<Y.wh:L>&-m2ePyjGCm\ze)-f&b)U6vD\y;r5f()πU"ia=8vNP1L4z[;\#8svN[uE^w;.a?8VNl[4f&))kYc7%LpKnOg7<its+m*#SzS&MπU";uSi?$AjL)DFBA3Y1$Lg#F[nsuQ^=/>0Hf,GnV1D^z[R/,%=5+SIxUIGBQAL]k*πU"ef5337iYg(>9ofY4i=xj'1mGR20v=#cY91B7VFPKhYW->4m19O2'$?rP'4k=E'eπU".4W-.nN*l+0g]_]rZ\rCz?jl^R:6HlERD+W9&4dAJ^J9F=D.*W0P-fQhXK]$TldπU"/3vZq.WUfT\wYSS6SkAM+OSyPH?US.#ZV)]q#_HSWOW3*cFa3:E$]5+2i%3-i1,πU"F<t8a&gG]V=C/xtG'f3?i#7g,7Y_P?\\V2YA%,<Bi%04[-99mqfq12#<C1^*SPkπU"Q_RFETgq#gQJ+LoRU$Qo:68>gsQYiqWU2Zo[<74F<V&KQ?MgNT#g.bG[fqh-;/0πU"PgD&qfw/9jMzg^TgL8hxsMO8Ein.XD7a_)%?XI+FqMOGLLL8hJbHplnmUv7E^DZπU"NIQfSnYKDa]eDH:h,qL*,N*ZGa+5-R*%C+*h<EdaJ3nQQ&:0f+NBdZrEs;<<'ZEπU"L>hBn**El)CRU9bz2VqQsrU0(dO<T6*8L64DCj2e]2&cID8>Uu(uVi/KvQ=UIR;πU"EFfe,TZwl8FA&N\Pa.G]U(xv'_>\[IR7>T3IX85NJlg4V-V*cCX8wDGE'vU?*VjπU"M=b41?xeLo<zt62/t.]<708eVc;(&=E4cHmQfgsB$X9+ut$T3[BPfZY$,]RbALMπU"_w64Hc*4xg6b]#Y:X^\u4aGXqB3FBqGWf150/X_(3n6mY^Uifs%Ly&I=WP[0WUtπU"1BFL39FcguJjriZQT207>7J2o*:g8BcPBSAUXPc7,#Y;a#W;Mr+bcSH:wQPPN%sπU".0:Yd]5rY8f[hy7TOai%tWjcSH2=UG3_c]+hDH.O<.hzf(0kBjh.'2NAhSe=yuIπU"z*QIBble9Vap-n\2.'v^4^n#:]qAYdVg8XjQS&IodZ;='hDX,A(LdlwF(G=*q/oπU"*'>mTS9,#zHdesT94[AM1.s0tQ[DN)ll:a#>*10AL(%bRs&T+,1^1rc4'm;'du#πU"&;cT<pH6^4k0lgoOHS+;H$k+qXI)gDGjr'nhYGcK#KwF9^2a*FOm$qjp2GLh]MLπU"6u5V[zkq=p;0<[&:dDHaeGnPHk:iGV'X7t8/kGvWq\'wH[Cj[K]jp/v#Jh7WfhOπU"=#1L9;2t8&?swYhzut*Ptn\'oAGs5=C(2&8cDox&U:j?9>1?3T7zMK\0Ie'hO-WπU"TccU)502n'AcZ5U;Q&FOBePCv\rF\;[kk0AWlWCu\?4guE*6/M4.NGx)$WEO%&DπU"?cEb7f.%VvlJRA#A3#C5h7LI6MGRdE]G0SUuVA8pV0=jbVwBZcv7T8O6-1Y:4buπU"i#8G?TL1;?#g=Mw'8dH=d,-[s/k<B3ZD9)l5fOXy5DEl+9Wycb1BVqrJA&-7YFVπU"GK'c.>uKbVQ_kmA)X(P.-d+ma,X=bE[4-pDD[.JARGS)lRX-KIzHQHA*KC7.S3/πU"JKOu2cWJ)C<3TLg:_IvoM=$ppq9u#_GV5d4n>lT;$sWgG9u]>JkK>f,g1%c'piFπU"$I8,<23,huAD>O3iE:]i8F+XKnr:>>X:QK5DS2Y1vnWX1/tp&WS$sEaMHf&%2qDπU"=&Nl2M0&tt&->M=<5#,z?;#?vOQ#OOQ>2L0bVZ[#?#Z+BH2E)+l=g]w>3%pfx^lπU"fR4g=ivb:EY:=4%>JrZ,,*N$PeJn_8>oIcd=1uWpgk$K[1tBu3j:+wUbGUDK0IGπU"qm/2_ZYi'#5Y$goL49[=L%I7p/V\6_SeB=p>E*&JaDmPCt<I2:6=p+=$ss]cdN3πU"=+'oa8]8WlP,Ao%DnQ*7$:OKj'uPqNlHq3hIk$l8vbJ(Qntb$4d\_df.2]>Fi\ZπU"X%=ehO.lILh7yC6A#O\Idi9zJ,oRi+kSXyd'QU93EA<(0[HS&]pI7n5.&n9?Y1dπU"aY,sW:g#=\$)7iD_)%T:6aWivH_5^)AC$gHu74X1F?z0C^Pj*(f_X#vo(f3K*k8πU"bV/_,KIvrN>UoOt,b7c=46#R%lrslY;5W6AGEHKX:dP*N.8&dq4F=/G5=*(h:;KπU")-I#]hnIE8,T+e'ghARLBS-&BoU-=YeAcfP8*oXQ-cW1IvCNK#[4:LO)$6R(jt]πU"kV^sDjs6Ge]/U]gf/yw*[3#;V?tVl:Aa8WtLwJYMd5sdJejL<^tiTU7jPf^lWPnπU"^^P<pKFGZs5mOJbYLo)8VSaJfN2aKt>_bMRUN''8\UReS#mn5HNWBise2t;9_)?πU"YSE3?IbTQ3sCA;[3+dXQXkK],(k/BC<HJfm<1%TO?%3hA;a0tTqQCpYpBW:2C,.πU",>/_LGFkeYQVZwTKXwIYRJJAXmH3]0[xyXYb0p9i(?wtH3ohY(.q=wKEnL/9;3(πU"1m'm,bVIMb'eoL1MoJhJ0RfX6xx)aKbA6p]0=+E>dxP=mTg+,tIxS='+M6+aWCXπU"sO:EH_*n$2g8dXrl7k8H<L/5[_QsdmuWE$GwTQ]m?]\R/WCk9RrK7;aufLt54o%πU"=3</kq6Zi0DRHwh^H3(u?*Djs[g%84]%WRHr5ku-Z,wx\]Or1r/L9T)o6\g0;#%πU"pnUO_K&TOy>5kT^[kMLv6\s5U7c]Pk$wJ$=v+Q3naKnQu8c4bw3EjdWwXusEeu7πU"5PcrwfLFnOq$X82V*phs-a9hTFr\4^KsJi7UavePqXM\RlOI+Dnc.#\1N?S;-DEπU"yr._Xr&lnGqAj6BunZn#wR>;]l&emrCP%O<0J-eEeXr2[E]h(7#F(h:0ZW8p>7[πU"KTJC#TlXH:ZiBBJ3KFqVh[_fHT,)S&vw:;$Wg-n\HRpqGkoh=qf\+4)._JQoI)IπU"\[)me?gtsjB;q^e/33hZ\dMwNAtE-MTCvFea9wZnD'exeXraKX*WYXGOKve<0E'πU"ATa25-k\PPAgQM3kO3<E0,_E:*k3'%iWSRiWSW&[2mkR9XW:C.xZWRy<lv,jZ8tπU"d^-L\3^sJd8kntC$4zlvtl2iN<wRX7tpK#h[f\Dc15^^46Qv69qEN%Kogdvp6SvπU"Y<s:,[msdIgH[s0^8py_D$lPRZT$vN#8YQ#?f)u8$iiwPSrIe#1U0GV$u1Yt?J:πU"IH,-]KN-b(qst^b%Gfs7QisYQ)Qgh6>??GM$\75([1JxuXLu,ClbUKWoK#l+qWLπU"b1s-K\#>$g\n17J\cZ-:I:gJaLG8[CI3393yT7Bw1hKr/n1YpGpOD)lm/:$RGueπU"B(]DM_xaRDie0u%Ao:)W+a1tYtViDdn2&M-B1G0wcF7VfCRGXzY+hW$[Coo:oLLπU"QI'jXGi,9pLb&3JIdq6>X3HxW<=u9aAovM5Mqmu]Q';]]%vlbw^lrj/Qp;CCV;GπU"wWn%l4)/rLXe(4v,-D3b87tAsfi.MrxL(]PsF>P/qI,)iFOB(>?mRdMG0B5$gFPπU"rKl&EUpiIi7yo$2?t<m\K?tC6IboqI2Va5AF<omfYMklRv]$r8?$Nx&m'^d+(J5πU"q%Vbf%stF9Gt^qN%_om(j:i;$2]Vs;G1H7VP<OlY=[pzl)fcr]/Z84ZYa\Uj-:wπU"rvF.nKyM]bt/e.xYVJcBo_n,BJ\Opai*ghgk/=Y[P^Mu%lbxg/FbT*u.W=CX-j5πU"\+Fj#][(W[n%R0r-%MWq8HeBdGa:JNX1q]a98anVrv58'OzP9xb<)[0:zu;N5q_πU"j>Ppv/PB=&zO%Qo9r-jKcg)i?M3R,,E3u(Xb/=N^wi5+hTi*AhmmScrWHO(nO*4πU"o-F.ZN/*7B.c5=-h<K\.1YqNRD0?I>Ga:,4<E^nP.1a?&Bq-28lWfi::*4ITu9JπU"JFz+4z5'g-e01jJxa-QY7nN*E4d^-HN;Olki5rvH)P;(cuKuHcdh2Vvd*Wldo-qπU"5_Fgy_,D0/1oV5Z/Z<7TF\mpXef(r5n[;C_QRa0R9c8(&c8f&QO/hm'Me$[HSw)πU"__k0w1axM/IvY4-1w_i*jz.2P9k]nxVcNdVILfm=.wnTPtg7'XUtZY+W?b;bP1+πU"*b%:4q]-&a^k?Vs:qr8XLAu^<D/6lm6qeO$<$rfFS?9e/TVJ?XP[2-)\^<G;+7&πU"_/kWig'o\\l1(%/szHQ(xAA.0kzHWK\00Rmd.''?N3;vV28-mECOxJXxB&&iP9fπU"UJI;VrL>5$u&CGx$\m2URLSugS#u(9^\'qvWXw#;NECC=yXvo'Rg)F\K#oo#7^(πU">3BK$asEnTX#4_O=QA\RKOQ6*)Y/bz>)&N7Pd?AP'k<1ehzb?'.dHNjFL^ZDNNBπU"[=(kAQJ^gRCc?RYpyklDpLU*b)7EM9L=Q(,QB**wOv(T2>S+Ji(orV5I'ke6Yd\πU"Ft;jK_'%\X<]e=q57FV.Xte?BGthx5VLWi,ScfO&41u'gUcti<&eb\i)jBkdKy\πU"_v2F&$vzoo%/'$)P1JW$s?+j1Lcq;/R=t83-c*XAR/J')wtgBmtrj'+=a'YQ+E3πU"3(vIxs[WO;?dS;ZUuZceeoWK[Ns(XlUPU4=e_I+sw1E/CF?c.Q7[>38nKL11iD#πU"OjopMr:E1\T(yAgHK=7RCQ3hgN5_3r6lmJUBCB>rLIoia<6at<RS,btLzG-J46jπU"dY*]++]Qf5DX[.y3P1[FIQ_yvr5.*kC8F>G9\.MI.iN^/:*W9Qpi8g9N&OG0IrXπU"ba:^M'bXtli%m[4Pet7hC]+-V&(+Q/YN\WJfY,8Z5:7;,Nx<W>IPa]WX==QB5k[πU"T:;+^5Ka%GRB,JQ98n/mma#4Ma=%0Q4dwO3#)MkcES(-qT;TIuJ$s^TtA0Ln?0&πU"*fZni<)9p8B7;BNx,KX9yQBBvwJN<LO3W'QZd&VoUPnePJI%(q57C5&k;k)a+NVπU"OGGc>E4(3UWT4;X4pUteZW1f\0]OO()\'</G+1(6b/6)2'iyIt^.Q&-66.by$pLπU".h$VE,inN(_=d))'IrRp8?Z,)e&y7E:qpbIt=2RKlcg8hb)hO[M7HojBI_W(AXnπU"q'%qyt^RKf(WJzWw-2RAx]F82#/NYVOaL20mO+M^Ho(:CX#1V8ogRH0Hi_(G;JlπU"K\Mx4Y=0%cIqh?B)RB,njm1nk=S#s2v+sb7jGf<*)[[m$dc(\N;1uIBCV-I+j]vπU"uZ6O]][z[WBm\mUsYB5rCgxWGF,r;gQ0-v0>1c-Z-&E1a0Bw2Wb>u_,1HLFB,2LπU">#C%Ci:AP&U>v)w_v2*F$vzKs\mo,I&.C1<]GTG++yJRfNN->q2r';jjvBrVl'7πU"TlA(fMoXg%e2w^DBBD)[j]ZQc-.Q7DJE?wm2u,ay#$7gy9b-6Hs16FfXbVV,UD#πU"mUVGye>.qAlEJWiCQ0c.li#:_.0]Jvb^3vYd^rZsS*.5w<8MpC[pu-'4#-NTLk4πU"VWS^81mAvZ<;Zwh/j#b2D0OcM*X(1^5'/n,RHZj/_m4BCDK^Q]4l3wpS1Mu%C\8πU"*5E/3#7_/-*a#gI2Aw^s2t$6>uC)9Otezcd&#o[zDLNR,z2Pe8?d%zdggj%9xhHπU"dXnU=i%gNnDa62L\2K-NBecTag3$daAcr$*UOOlBG*W:eyvn(%(S=gd5i>tB:ofπU"W<+)LEtIbL[E9qnIL88s)x8e<9)>.w0PY-uh'[g[0j(FNJ#h^v7[t+x,jwx>k30πU"pYa_B*PL/y,Xl.dlspd_.ojzoRi1=tRa:]dKfOwB++Kb0gqg[Hi#Qge+0)?>6MdπU"(R3LF^dQagrVd&1aa]f<7R-)qnmc0:i.toOZZg:kKE>A**LwVgR(<5*%%>=ZmX*πU"Edvf>\r\.3&EUirA<_p,'erAJg<2V2_rD?/Gl?R)h_k]kV=^CrSJ/vQz[,W)MB?πU"/UsRcB\e79NA7>M^2>5[$/?tE4-0Vr:68sv0DMuQ7&#ZN.?drX:+0Z\WSVIzBzJπU"NSJE3%dl%Yn_u+oH43qLs#30'*XOdBT6KuNJ<l>.st#c&YL'.uDD7HEigg0SN/0πU"Vxtz4H-l26rL2c*9S^[jrfn,$/.ThUnD[<<<85FQlmlt9H9]6dpi\i,q;4$-V<*πU"^7uILeeSZ>bhhH><Yg_'pOwVj/ak3/FA$TC&>w(_?G_s]6[/a.?Ooq^L[PV+MYKπU"v(ej)+,6o.=&JMeJh'^arRL'sY7/UoUJl*7IMxr<'_#rxx)U6J=7\/jiRu*bHY\πU"61toQyV6KVy-)p[PNM?m1S\_j)$O<'FFUXZ4/hO;2IIS,$Sb9Qxl:)dt:XZFQS3πU"t)c)UTs,mH:E84)XqD3(<9lsSs&^cH5Tnmz+Eu]L^QpgKBqwMF[E+Xb/#$Ln(e>πU"t&IJZ/'a%Js:ej1E18N_S0A>-]*=0IdXAl7x#E/10#l/WSS,XjJFt]IcgjV25KuπU"m:RkKiiU7Jvmu\pz*Pncm'RWgy)%UQ.*G:chHbmZ5N.mM51J.LlFf8J*l6ve8p6πU"t1?f8l3p%xTsxtS.1MTIr3QqlrUsivl'q?sp1x^:r2VzN6;nhxkB]$Sok)rx)K#πU"x[H4<2fc'XAaX3pQO$S(&2_Cv?GiiBGR$]9UIlAO3B\.*]rUf8*#'uK2QKUVh/=πU"t(TW$fcJ?sF[1q*r=dQBV&1*xe<hJP)u-8/(x]<OJFSaz5'IIFR$;:$at*w5uXIπU"P0Q^Caa><T/:i(FD(ubadqSkYYza+U_ma*wipdXSiTp?iQo_6r1f4'od1%J.'VOπU"vmk^R+airDPOMNrCnm8'$t055QK[3VmWqDCY[sLl*hBwN[*r4u8:4HUiNX(V;L.πU"JRCvnn\D7zJK1NsKp+>:9[NBo8+gmL;0*1%PM<[Z'8)6x5s+srhl?)ejg*lz0nGπU"rp_R7,kMgrFf,u6,L.tr=WWi,xs%u5%5]:2O<z-s6^QR\B6IBYtp4UZ<.\A/E,4πU"i<AGV9,(Hdm5rg-*6><&8Lt9d867IV_HezX_8J4(sXu*8>lQqY#ZcjtAby_$MONπU"]baxlY7SB/(bqGl9d?1e.f*TjzH-H3L8sRGaia%I1-MN5q6i,gt&N%Feo<_tHJQπU"Fd[]?%gck=pF[0U.+lI).ft'?iOUl\/at],?MY_3Yw632U<u2uQW]2Y$D=+=7E9πU".W%N2ueT6w#(JhtF<]'oZI4X)gQ2W1q_MxxXRqHv6nu.lrZJD3;qicnIXPp+mlGπU"uEEY#xBokU_U/:XhII*_g]RP\iu6I[-zukTkyS)tX[lh^#_Z0CQN-Z#)RlMxET]πU"?cIYMIJrX]#V=lD/3)e;,f;vsAmVBZ_-=eR$A]XV.ZrA2$Ha(f_i%3g$vX--L6PπU"=;MwE)*TPt\z0]F<u.hOsQAI8--$5qcFjisrONlOytV7#:,R79'p$q&Eo,Td'BcπU"79B7m]zwahhQ$wB5Ul(GFJv%-bmWj0XD0&*U8$fRt^.4VHM.7(#n\$u]CO\3LCgπU"Lt]=%GhbWH4Mkgm8Kx1rMmd$3wb#RZM1ZNN?%i8b<$^,Yu_tLcEM&HXVE<c24[OπU"QZോtV8Ins*UnN*9scU_J+Cs6K$Ho(fG^tB&-PU^yVrW&uT<ne08k.c9VAAπU"H>xIQ?>4C;Yj-R-5Wt&#wTsmP;bA3L0'632$cT<^LvwfG2JW<D_.D%z0f1u=MπU"-QY&-_0SYRk1=gw>wEkd+s,GEwB0*/:x;7sen6fP9BHNDHb[%rvh)Kqx:jdiQ5jπU"]BH*qX94)bE4xXXn4ULNrieX_%GsG;bK[n49nycYR#E^-Ku,UdpAHk4o7nLWP7iπU"3Am;tuH_dEmbGkf7]-gsB\HWJxWXpOnC>Uax-.SQps#T+l0:o;>j0<exnTJ[20eπU"JQ]M;mMx7pi<oc7u>/SjcIo?2]I]1fufXfh9?hmy0,%+sk4YTmuf%Mv0Uvp/S,LπU"<<(8<Dj2^gJ6Ys2cc[ngD6hkl+t$LP3grx5%bb04aWYaDsPiH,H07/mS6S&Hoo>πU"G,TRYH9U/s.NMbKmL,ah5c5_(L/3;Mi4iNqu)NE-U):4H00+S/4)'$I=AMgsw3AπU"yah*1XP*bcf=<g;E*;AcRnt1)I6>$Z/dxeE?5O;D0XO4_4C=lmmfAQN5I?ma/'qπU"Z(Z1/T&BlLu<#gw9j-0fY]Q:sv7liOZ.*CgnI[i3pDn6s.V?Y/Q\P2wa_)3Eg#[πU"k_M[9jb/X:aiKRTW+sUu1],&AkSNAG4cfsXK*E_1F99u4=5R;Tplm%6c*8;rxcaπU"Pl'anClZD[_lZ?T.fa]O=QS.%idmv[$[k8k#hp,^;WIG7o>aiJ02XDCibdqKrg<πU"RlK9bwg6aR6'3sXi=>svMx/V,&0Uv.;[F.*t.*xg_FFF=Hm57:nbdfAr(a:q4u-πU"$):3h;TbfK9]E.9ZOE%8u)JgTb-Wo5M'Pvq;zI9su_Q$35eBqYPkY#Uy\r/a3nNπU"-Dr.<RH^]2r[.;p-RnHS?$$sc)d>vm,<uG8eS63sYUY_8l9M]b8hDc\jFIZ_xA7πU"(Kq;p>Y$4jkCUC*;q)6=KQ=o,PGMBr4i^HBT[[)wy+7bYi-46kUACd:/3d$Nnc=πU")AC4:T^g,6.b-6g,R>ix:5/[fR$2I'/JZ?q,g&1'-HxV=Wx#84Xy1C89QlYr\kVπU"BGJI[0w\7kmi-q'D)2nG1tR0ewU%?gSK]'-'*AO/X3JQ.<GUQKD8$1de5\HkFe=πU"G?wI(YWF>DJrK24R:[rQu3[L&FkSqaL?kFHut=zd&?:(^+]V/ccdW/S9Ks=,W*#πU"h_RF6?n9%AX7uhA>=$bdWNoXhT'iRoBML<u3MZ&\kMdv]=OSe[?n_Xufkhac?MkπU"Ck:5J7_WD.zkMXJ0Hea:WD*>Oe1Vh;K='Bf'[-o>#4^Efy/rcZ8maje*c>iqk+aπU"oET=Ve<dIha)Jh+B)5>\pVba[]I'l.JxCoqlcMxE)AeIo$)EFXq(R=r,Zg^o#leπU";<VvH-l3G0.>)4.u25Kd7HTWmZat7+X7RxQTlUh3kl+0a*+LoZ]agph+C:dvHepπU"9>=\_$G+^5&>+:lQ2^tYQ]2uL0Y>P[s_jkmGLU)bk.n>+_AESWu**3^PKK$:gKjπU"0c)CTs?>(?J#;hFXE,$ukJW2%pV8Q#KVl>%o8I<_X%PydlBF,n,d/A%'r>)bMYdπU"u=dZw4-b#RSvN81jd$UUN$&V%;md\d-?K4ExcN/Lp0;$V/)P44S0G*nFpwoY3sCπEND SUBπSUB V3πU"'C4pgSaVu&b%7Dw#PPl?8O;s%-Chh4t?j(%5g<N%IjU^V[9?I<bK*f;_K4Jq04IπU"Yfc_ZE#On\ESaC]w7l+k%q3Hn;\>v:<Y6EwZ4+8gPPbb;4l.13B2Dt\4jg:v/QJπU"nTt;\NHOeMgMBSuWqx1h9*8N372e3e$Df(KS\Yb>C.w1ZiO39GJDW:Wdj>/Vs4tπU".T_uDepsM>t4ORM=OO4jLI#f;r]*UnBC4IQ*agDCS-f'uSq*X.mt\_9P:Ge*Q=9πU"Yb?NTkIn#L3t6tfs:FMpBEO^iX9H3R\h&'_5v[Afo't.sscdPhhO63v-%ItY<SoπU"n$>g_NO7<<#h8\7i/eU)FkjafG/$ntX'l=:'PD0v>NQ'7,%nHmBD-bmT,$m_lm.πU"VAnP$URgoRu92(]9tF^_zder]0:GVPbThGUoMWoQE]HkR3\dU0:'Kf5jZuEE;76πU"$CTf)K(YI8$9FM8btbhdfDqlonDMUAt4*NPWe/WQvr_U9<GI[+nEQ3(QYAO.us(πU"VfOo*qRjcp+pii?vn4/P#$:y6?JG9h[EjNRLd?Z&]<e^C+n;,$SG-9Bp9W<K734πU"3tf]vB:.EK?ut\Rcn_A&Q$8,Ysg[]b0:[m<Sc)6OxDmp<Zi[sr8Lim=>s29^F4zπU"dO0Wr[nw;m+W+wi0Xo3]ax/6WgK4p2+AB5up;%D$Z#j+*n/iu%;:z>&>>IPN](SπU"<\ar[9o<H#xGA'lLt>7K?]#PUg*JPScYV^x8lPtloZa;^2^'KsZl07M>M4Zam-4πU"QCe[ppjnT5tiTLC/15,qn/$9iM'jf0i;8V*4Gl+BWpJBD//x7)p_0Q<X,wB)eavπU"3-iACq?:h>ldDtQ)0xCV><o*K,Pu%i*oOnp20D#M3KphDY:#mS4]P(pB2K%^%M5πU"21ZK[#FG1TLQsO%^&y8Se)4q*x7_nPZkh%l-EdT\C1r4hKQOE(SddG]n-o[]sE;πU"(hPT&a'JIW]CD1:/%WFa]WNB:>QuMiJoRHL]isy#*>IvJ49j$id2Djhi*1h*:;jπU"vDEuFC\FDuTin6UZn'Xup(%)9%%%%-%FAe8F[f<nfj%*%%q%5%%+%%%%u%fqSggπU"nt&V,ASm8l6Xy5[hL:(BfRQ;E5#7&&LzDdd3KZ:a&[yo)=_?VJ0Yri7>>lSu4(1πU"H')bH)LW/k;DC0pC9p^v\H&OFk,k9R8A7RgfS^ZLZtfmTl^<[<iCv$6jD:cFaNJπU"Z.-EuA-?J\?P*$Yu'B%'YWF%;5OJCE,WXekNO(ImoEY//yuh0%%b6&xK.o&:A?XπU"%UlF'm=Oa9&k0&x2E^/:)'l>p??E;gG42q2$E\jf^VfQ9RLs:pP4?Ju8C*iC]^wπU"gCG+Gm?575jTcZk]pP[JBe:/SP:EqzgE9i\Ez%KG,k:vbLQ.km_YO*0%GN#Ga9NπU"^KkA%(VK&&C38udN6aMh3#[?/AJXE.y6%a&g2N#9]pAIIq]4PUedm#WE#eDPuOuπU"f6NcKc(41yF'0Are$By32NYpaF2c7+y2>hmzt:$.l.OyOp(<p+a%n=<U&%4CopQπU"zofHxRijgMglNa'rRACq-&m(8NC_q4.Mv<P<I4_opCYZu%/.36x$J+UYvq?>gZAπU"^cq[1qGe\mrVj,X%ts.DlA&IZZO.dTmnK6P[?8q?l'q9N%-f5%iuBHePIL(k5k9πU"WGn:wW8YzFp+R35AV*w[ROPHp3aNC$APIv*1M<H4e?(hx>UodXccrfLvMh/UV9fπU";5\j'Vaj4u$--CCQfy+^=$EL(W>JSXnH.3RsvmF%*1tw3*O'f8e_%f[KPCekUF%πU"#*3aHN4.0)jq(WI;8#;ty^5$Hi.lMs/h(SoTD8GtR4tVU,ej58g0KwTfQIa_&,pπU"AMO:L-272yC$$,l3(W#jrWxpa]B?gjOH0)t[Oz4i$/E_ClA:,<6p10DaN[e-,2MπU"(c0Kj(w#l\5u=vyJ7w:,>Lamkmudr,XyiZY&_g3*lLEn7sD'xK\$[oMS;bEYe/aπU"L,e*D+:<iB<r6N/56Ul8ZW&C8q3*UP<OWL6(Z<4i4XVe8dSgMrR\_<kf4FV=WYrπU"?Ww?m?vKxZ*AI(nB>Z<LsJk7aYL:9g3d]]ai)hIKIam)lb3CF_ny^cJ,UD8MH,?πU"5*o#ZitupBTR?<<_H+4tx=nbL#kXNjBp1nA_Z&l8k'HaEoD8#X-kTa:WIzODvlrπU"b)X$iV'irE4AXBN3[zM*P8Uh5v*CB3hzY,7<urmK+fC2tI7XRKE[5L+l9NF#)jaπU"4dUXcqA6cnd3ovJ#zQO$]gxB3t04&c06NE-/uZ*eH;Und:qU1HUxgM\ZZ*U&e-wπU"93F>+Ht64.*]q0h)HP/WwD4-H230$QLgm$D(UnSfBkQ<$-BZMbpktH0L1jhvA$YπU"hs94?]tPap;ff6?5>f99nf2xq,b3wrElilH&>QR9JG>DpD84_)jJdk*D;k))L1.πU"?/[zi-8;n1A_O3Ys_IJzuLq^opCcSs>>CN7?n+gua28+IGiVz-D;jfAxlPOj=\0πU"k\BG9a_Hmfq8vCa8c]E0Hx\.9=f=9^H_6;B=mHi]f/2S*8bfrZ7Ib-.Z\]O$VExπU"K>8cUsP2oA:4lG2X1(dRhzeZsMwE)PNSjZ2s,$+/c7C-.fLG<?Pz$P;69^pAU:7πU"DC3eSJ';0(x:FiJK:L):dNOr(Fb(z?zdR]1)J]?*#$YZ-YA^kHt.\YZpAtyR82?πU"bpC>7MgX7+S\N**,tw]t+o/-a[mx0aK9BLTU^mng4f^p+Vlb\R>8'1ldG'^;xZ/πU"-[^f2ZbcB=PXK4;?ifhf]jVYpXo(Cn(p.Eq\]?0X,_<>A=8fN3NT]/[duO#w46(πU"<49.+K)Jfr,.a$/fw3h>'wNmts)kJ)ciq,#hHQ,EKILBiD,x8/FsrP)i_(u0(X.πU"TdU>VfnLsT<N,/-rertK*E<3Va&87^p0zx1h)%zqJk9KUfDS>o5J<$#$$.=0F,iπU"dG;N#jitUgcVVr&8-An\T-%BdWBgEZALl0Hh7TVUvqu2>UofVXuhU[(T\?UivxgπU"J,h7>N^Xj'x'up%()9%%%%-%(ea8FPpdpj&c9%%(o%%%%,%%%%ufqS[gfxfjafAπU"T:]axxVdFaG-\,bH*DeA$E*6KDE+;Li8$R(IptEgH%;nf90OIp(InPIfW4&56#]πU"Y%a<Yv]]Q0.JF,x&B>_7C\3C#\kr':b]a;SJDH.vi/mq<=jns#J/rjDQ:q_dXfOπU";Yb9FY1Id&<(.f&/KKk%2\OURZiP9XN^H:?O=l/x1NHYw+#wE'(M)5-b(EBK.'PπU"g.+uXLf%9G[PnS:j5%[q=1&/jb4F;O8PnWf=\dU7R&F-OQ%;Lk1Y/[-f]IZ:oBIπU")e;#dM^254*]X)]3l%LfYvCe;TaF\2?#o]u,=XjoKHi/=*xJ7H\Yd0N>1>U?A=%πU"*$Lep9RL'Krav]n?>w8]1;H+I5Y+[00H)$(*1/Qq\M[,fS164PEHY)>8gn3$L&UπU"d)TS]:9k[+XiC.'^^:9*JEG)Ye<lUlzNyof7_IqWa)f4Ux7gsbc)YtFDlAusaW[πU"S^lVbcgB6-&O+]hs3]I0\w,[tIOvH)q:NtPYGG<(Zt*L<g,N:#,pK%z&SDK-pQdπU"SuHh7b99<Jt/1Ll=X_Gn8DeVVl2Js*F3+*87C,ank?'#Ds$0h3^*eM5;nF7/cr=πU"RE\e5AFXteK#dHdwh70TT%xDV#O/X#H340UO5O6OX+dhF\uhS(EG=bk)de+Jm]?πU"gE8sCh6.9tt:Y?JU(=J)PAa7jLUp-xK;8TM&*D#m=1o:-5/X3p]AZH?_])2xJF6πU"leh%72)ADisG$*QF0g9cT6Z911[J9[?#fmpG4.jCL4V1wg'%WpkF1bV9:*22&YgπU"#5g'AI.^k'U6Po?A?N^<3xHGN,$F*v$>a+*)oL^5/+^-Q;5TVNdP3*'F:Lp+7E0πU";jG.9Im4U/b.LO:*)Pp9u6;V79fUpm:LA>MM7.^dS75U1Sp)PTpGpe?b3hpgF4KπU"V;/&fP\R4aNm3x9FuqIdJMuenG;0]rcJ/w.ZHnm4e1d^E,3Wa;KNQ#t.<]Z=76cπU"L,=FM.aGQ<)OcjF#$:JQ_tl0B(+Sw/H8ZlQn>QRgfs>HqLN^Sg'g]hXxAF^FPuqπU"(f>R)lL/Ok7%]^LBs;1jYo'&35ufVoq\a(xF6*_7t>vCJ*6-)Tu<i--$vPh;qDbπU"l>5xxR8LdX22Hs.bwHa?:0Q^j\0_ZK95lwr_Hy..f9rMQfb9tGDV[R#sZPds)eMπU"r5\EugkV&F0wBV;Q1p7%+>^G+y?\[/(R/KCaM;4x$iZ*^:[)U^U]C?d6-VXmX?XπU"jh\i)I*f7UFUEi.>ijejLa;D2oajIbU)]0lOY*1#w(P?LmTsW]X0hc7+rc::eLmπU"FR:G&U07GBP*oq2]D>([T'F]LP_:((&BUP2lo/Vk_-Z'dBk[g?q;??r$$Z>OPBMπU"225WKM<Kf0^-o5.J7fQq'8xM7s7nnY.bXZ'%AQEbInmlhKyu4#g^X4RFhe\L=.MπU".5k[0U'$Jx(Bo=Y?v\w_/8;N',VW)+>FLdtHP\0?qBNR?n.'os'go3<7dxcpH-dπU"G4[L;duQMd1NUg(-L:,yCF&f.T^.6xr&AhNLb+H&+b,Vs*i[9(jJ1Wh],;FnY,TπU"aA$G/aQ,vAn)F4Of?$CL$R*gkKg\(r(?StHV\;C+tH35^BYRt;61aC(LA0J*1imπU"&VliCMJQrZr(7,2+A<&NY'=uW1=v=]k\ljLbi]]sdj-:I+;w6ROkco7ipm5)]6EπU"^eTaknl0*0r$x='BMp_lIc?&3oE.9<K0kKYU)1So%8*\kGhXZ55]KNlcn7C=*C9πU"4Q,[y%sh7J+xo.,)60*S*BUyrF(Fxx1I^?t^k'^ta2T:uqoR*;B#W\WQ[DQo.DgπU"TmVo;Z>$v>tHCGS^697_k^==8A:Pw^L:p^k6IhXh$r\CfgUAam7e3sYOa[DQbDdπU"FWgo)w2j=Z+xwx7,0kZd$j11b][7AYM><uF?,lKJ_v$Y>(^ro&zP^vPIm$7jXh^πU"gmKxma\.Q?fK;T?MDE%HqrXJ<vVlNrK9KdT^'A2B8h:uU7TXYmL,0a<sUHq?M9QπU"Umh5$cvp=Zi5stvbIl+B2BZLjPw2lUqsg'&LGt$G;3=nA;S*0C%ETSSU_k->:1HπU"+S:)a)(-qg/DW\gZ[Fpcj2X[?anMPq6e;C)QVLF1F3a<]r,W1FLjFN?F\VlMA[-πU"p^^bS3;fu-d6Rd[nYAm(]QDbR/y]g;yVgkyD6Mqvey]6*z4h$9,(fanwWP,x4i7πU"YPNob6gUGDXrs&bB?r.&a5_w>RVLxpApRg0MOvo$a,RgNgPXoakGzkrd9B^j6MWπU"%.o9,R5SgPVd.VtS>8a7GkiLF^SxmIi?Ba7O+Y>.n$IiNb]7OY?K-unL)DQL5U6πU"NB3[CR.6^GuHZcVkGeJwjGyj2,12p-oKk3%TEPPoV)794'SS:#:8\mA?#[;k^;EπU"P;k?8X],[8jz_lMfreEJp5;E^0AQvcoWIw([*Q5&M8A?4fjJh.,41n'edjkH;XRπU"Bw#&:uVNY8mr).[yEe[7>xsB5$Bj0560i:J=k0&r2#>Jns^ovKHTY<i5jruALQ<πU"?-6ymP^WaH.42-DJbt>X?TQzu6;bxtJux^XCxxSo8tVkUK^Xgokqu8=&^)Ec[ExπU"RI6$:6,B)wDL3f:W:hCCp4;KWcC6/A$F*=zN.o70p7CEi?YWAe^#km'_8x,wMhMπU"t'jL'P#CZnW3\6Ag'i[SI+X>)<C/.GyncIfGJBN_H;T2;Gg5C<l$HJ\C:\BgE_LπU"Yk*5_7zF,RQ$Jdj;\)q:0to5E9k=.dp-]'AF&WESCi=t9TO#fvby$l&;d\_ylN,πU"#)8,$Q[j+D(n4<=HyH#\lQa#)9H8Itu\//w70BcSuP1C*X6;RjS^;LS,8qgM77qπU":_#RInX]n:vXFM_]jU14#2?\kAZ=[Z;V=TE6$0J7H<oKpS;>>ppR=&\=H7h)$)pπU"m+-'U*7Q=R>?pg'kB0$R;(2(0QSdL0Ok*:[r'?G8X>MapKrP>pNBa(V+.\I'3l]πU"5.8:']d5qFU*YitVK/b7p%HAK-i3\UfLFr1AKcSUNP[3W'-]3^)<JPc:\iTZ)V&πU"q8Q]X>2D<e2C\mvS._fTGTey\j0BB&JCcm]j,0>p*lQenAc$)jkxG4w'nE:tY0cπU"2,eyIPUB'y9S'2.fGq^AYMat'tD\*R29mLc\dI/ty<^.TF&kxJ4[Sk?Vqhi'rl,πU"b,Ptu9)w$V.'Ycfmj%+HPA:+K6,p[d,\79PVbwnQdpRm3Y[2mkj9M%JVrc^uqV&πU"io4784^:M\<n^)e&O-QaO]6:&TdEuawUTh336xn.+6LmAnT.JOh<thwg8dP>LF/πU"Hkvjc(K8.Mhr#HC<-kMQ^bp:,-fx.>J0^kOm#ieW=7md+l^gu(hM.kq-VDi:,>uπU"g,usxDCMS,iW?C,MNMMomQiF8[dAr'7:%u[R=3NGD+N]8q8vP<EBDR3^Sn^:[YVπU"CF,(eSqqf%^l(#=tX=f-cJG0B0+8>2]P(2rU6,Wa4yf*5\)Pm<aDpuA=rT2e0EiπU"i93:n$j))G/<aAM0<O/[.(P5n(vRo1#3z*,pni5VfoYz?M.kZ/y/2sa(B2Po>'>πU"u-<Xt^d*oR43tV8oGw]P[[8-S.k:FTUWldZ^H?+tqor8C)9?L5=5Rt11i/-K?#'πU"[IR5NNUJqj\.oKwCZgZIY[tmW:%3KtkRbE/Y[f_geY$H=/g(H30EM/dj\C_uHjPπU"Tg.p24Qk8w0^tD?Yyd)NqQlOGptXLDa.6QF'e'D#3lpX/7MJhWfIU;m^qTR6.ndπU"\n#9m7bc9HD,B>x-HC)igR=/Um'+WfQD&IM7z3LwxtOoDbyhzb-8AAG;(kmU6)%πU"238E&<q8HZed5TmIRM&V[#L1N++[z43+WRl:+1:h-s1A^9lejD&jjZc8Cp7C)DjπU"K-Ur,/S_0%D:#(4?S,%h=H]h'U,rJba'Ur,h=.xlle_l*:YDP]sk:i,e[m]T/g<πU"QJ1S2PiWN%edJ>jWMONM\)0^&x1pOxVU<Kqg389'1Tz)YPRVL+a6T#]--%1n1kAπU"#SR,Z=5p#n*&vOzpr_^cg\5(*4D%adW*5)qZw[Y4<#]GdQW2rUHLg\A&9?j*;zdπU"VN<(d6r&VIBe6bt]>PlHXyaW0n-O7][JY^6)G0DVrt;Cuo>Q)PXHJsKi5Gv\5\IπU"fL<33cb*&5u_'%kpH'-HQg9U[L9GV_oaxc6=:vfFAk\1HQ7.P;H&fhrN?&f0<yeπU"*+9'iv/SOpvM5#gWW5O=e+mkU^(9Dou?nt2U&oQq9?5UW(u+C;H=Q?MO:-9\pdNπU"KcKX*AbyNR-O3&*Dj\;xqrm<uure,+XR46<kS'GYD\?Gga;lDx3\<_bW9P_8j?vπU"B+Ax4>(%MvAn*tS(lumv-k'=5T[%.j3//[j^Snu'sO]8m)1Qc?>$q*<$JtlBa1PπU"q+T[GmiZM#-\.emQ*heC9F?D%0:dk:Z]9Qqsc=d(t(9-t7NAvP+m)mNxgV&[eCgπU"wEZ0\n2.a6seA2AtH]xu2*%47KNW8h%+_M?TO&OSIzp-]HZ^UB*8t?NHx^*S?7pπU"9tFWJ4L*UEk*EESETdu29B,jKLKF+lN(r942V3Av6Ha3_>S<[1HcuVG3#8(BI8_πU"1TnF6Tn$$0bQ6t[,xEPK_aOK)]S*0sZY^rB3iGGo,KGE8avIn&7<4X7\hY)[n?-πU"JfV.I4+dvJ_SvjWRtXWDiDhPIM(*U+3HYa]OP*F%=gpWer0)IAP/hLXH6pJS'hpπU"-do]:8G$iLuqOs35ZV*9*4GZO:Xs-(POK2fZ#Z5DCw;lf1d%Tv$TM9zB;DyZ+^'πU"?G]Sr(Q\KmW]GqUtiE4[:c?k3aCY/*dCoQ&E_J.tFE.^'LEWuPeO%vc51_VpWb_πU"s;IqEHOKKba0[_tjKOV%(*K3SK6X[[>Q?SH&Xks'SdyTvGV(UM+puB%c%[^bRUrπU".(w<G('N]6Po,&kP''s<Bf5+_^vs_jszLk5ESAba%-^FkWsO6BPYf-']cbHUArFπU"KKD..oXf$]C'no,:tvP2pnbJ<L93P7'DmSJs*I2Vh=?F8(TZ_4SyEU\(5E6'hH)πU"5elY&nS(CZ&f)hlouo0/M&4).zeoLQT+FGcrE3AK]l*gNf)e'dD1l]E6kYg)m1nπU"&;-\7z3GUsRKWFcMLrNnB&vJe?YUGf40l=$SH-j4SWKnK4<e-Z]g5M,t98)3hbUπU"Bl1?V%fJgV^]qqU=#lf6v/EA$>]E^FWf3*z>_)-kD2Fo>$Z#f\2pa-(%jZAquYSπU"?d&Yi#LcslAj0>bJGbTuYT:2mHiE/T<l$N>x4opQH73YXDS&o&2A#c+O$BO7Y4SπU"FOk[.<F),>GfnAGC:ZRy/KG[y+J2h.T7g^SX%=Dh::$]j(LcCadt<%i/wotIC*KπU"LTfgM(aJT&>EJY1&:H[RtRH>I.m5migWXBU[r%=qZ>8(IR/dDfRvU-6(.k4O\W.πU"v^jj_kt]^jzWfWLeIiz&-0c9$x%rB:?bd0jhLlDt0(xT[s0_[,N+eSq\.bPkLJGπU"%'4y9P-PegC=.t<.;+OZ.SBaC4M(J4xiX70,<j1d<XzOW8)FE3?H'8OnT*>>pK3πU"8lJSgx&M6N&mdYwPhYe6qd.3IA3;Cb+7VcGja/?F^iK1l.N-rDHcsFHP;/Xj8X?πU">#5NP4dbDX(EVRNXc#Ko<9Q-Uc&4PH3,5MFOTm5Xt4LbO[Dv$>34qivQrl8=4y7πU"aR.\ON[rF\S3PQ2*F2[zMCk8Qyg+2Ll_>%Ra7hf%Gvbv;B=fn2QXeRV$(9eW&/CπU"OigBLr'4wUu>7d9Zg6>)&T1T-DWYdmcrlc#P'cQCz*^-W/p53(:pFVIhT5)&LmDπU"VK*C*-gpTyNbh0+niAT&FoDd<3hH]P^QrU;0AH3\j;'m0<<R'LgV>K,k(SG.:MyπU"9V?IjH60qI%J)rAJOUBSka*?RH]p?h7OmZE4TaJ\Y\C8:l3#=kS.HK0;L6K0[X%πU"W(d$Mm?eVAlDHYE.zZ\cpqu2p#>.N-n4**51)2B^3/tmQ?Dh0afblzkK<VW&_tKπU"pp6pb\oJarf.oYnKb^kOLn.OVdo[UO8j6qWf&6?1;:hg.pI'XuuDQe9:Z5+=e?aπU"FOgbV&x45.r.s&]G,X93BiBzm&JDS=+GV7KG[Zun-_^gNpiAM_h<.P=U^u7ROt2πU"+rKlU><^9LFM.t*?90Dd\Sbgn=TBtPEjBCJt4++=bP(0$;WL-.h$%,tOn=IT-TRπU"N+ju=ulxhOgNUjQ_)+7T5lk$+EbR:<WrlXR_uEA0Amz2EOY4'imDdtgd>8,zdGPπU"c;g::n6)c^XmwaW(McH^HE$Cb^e^ks&20omMa]hqDyD]\s*2N7PwKDc+aJkMJFPπU"wAMhk(qmwFx$YMk$*rWqi]snA051j#j,a\8j*c,#MXWZ4BZLDeKVAFJTMG%kB-2πU"dKVl+JH$GFcpX.<KTA4Z0bH*ASI/496zwfD?pau<gk7,m(QHkHj-I.Q'r%O8(NEπU"5PZ849[eDa^qf3SF70j6eHQu%0Q\tR6,Zj^D'Koti\IyGBC*ll5O?=-vOZrU?fpπU"nGI6?Hr)$+gm78g0ML<xeR$Uc,ZWuKO(6fRAw$->qVB,,bMXB;[KQo>1NRSCTxiπU"%qD*uMRmT6d'XYXUXde*D$rofHiTaK2&M^,;.0aD6/sP%Se>76BH33b6]gU=S.3πU"0Emz*[Yg+NMMLZpAHtga0(X)*/I^Gi(X'ukY,)=&zqce:<+>Vrx]go2Gr[Bhz6tπU"geZ^mt4[D_LuiwWE\on;JnFR-7x+u%p()9%%%%-4%V::%F6lv&5D5%%%#c%%%,%πU"%%%ufq.Sy'yKV$,blTA#hQ%[N7Yx]S,C<WH&PecCxFy+Dc?-$vWkFPF'-CD5=GaπU"\*5<Yh:w?58^\oTzB<#bI4xIyCb.GbgCO1)ots'+rpV\CLw=.qtNtAFt4K?El8dπU"rw:8prqzxqZHOl.rqvnu>#T=dc90kg%^]VK2R:$nKhJkzex:EnPSW>n?qalEpR[πU"[ZY?t=Nq>2oXrqvnut8T=GrlJqvZXRANltjNsXbsL$W_.moH]x%6m%(98+TZ;KJπU"?*v?m,Lqvj18.;\vaMOS]%xq]$tig)xAnK#ySR07.t8Zs7G>K:olA-/c(tf1#'YπU":RQ<;R[XEnHi%CTJ%srX.\9+g(c9E_5'o0.X\dn+[[<-QwIf:_Yb+E61ed(x$.oπU"p8H%U;wZtfG<C8c;'to[3)0I7iUzOX/]?2)roW<^&Y2f1W(I:gIgeF])gvIK,$GπU"Kp]AB/b_)^fBqh'O5*dZJn7&?7^:Z5bphBEA?)Ht3-feu*E&uyE_i*B>\ZEh80rπU"'AhaZw][w+ws*6IM7Gi3-(nd7#-9j6AfISyUREr&gxIQwP2SfODm69R-3(phJ+#πU",Eq35A8vw[N5/K[S8J+8;*qrVuR+?I1isxQkC7$/PZtl-o3=Sb%nwq#?neXE1MTπU"zZ]uTNUS6Ot?jvaU6O8\pL)nZJD1^np/C7h,6C#PVW(tE/J5J2cXO$&i;eWjkT7πU"IkW*qn>bnvt^p(Ac_\DxiNhi??9sabKKO(I37QbTom,&.U47ebGOvQXYZ+]F<c5πU"ooIjU%amCxgmF^U*)AsML-qg'\y7nC8ER+XT&ajhW96c-9?,EsHZg:1[jW:A&FPπU"$UV5aBLm[??nb;[%;tah5M#sbm3O^G5k/uI'0?p;_G_U>3sH6vHaFfbr]iiaid:πU"fy%=;SK&Y4,4A^u:$U;7=sYRG+;>M+C:^)adm?':cvDFUIkm4cJ]*,DUcss44A(πU"VA6V-:W>yK:FW8wH.9%_2nOx2CYSfp?T_(w15o9(S;UrETdq^.)Biwh9H:/lY>$πU"C;TNY-j4sKL)?B;Q.$&MTV_H:P35&tsm>Dq)(Y(q7gu67l%IB7wuI3\?tQT&q\EπU"#FR7/7nhBeau_'u)y_SGnN6Z5$Ec[18OyGiPhrgCC:k\%F_kytBA[CR7&EO-S4nπU"?eSb'+8gX2/8U?G;?A:M-(J8If%',#=?2[eRlSOA7G\HeHetKSh*#DwcbTiE+a*πU"QH?5i&pbE4OUz:29;H6bRhR(QMhLGi&IP9*42^XT=a6#Z&.t1&]KGhSXj5KY<V'πU"kJ%'O8mb':V&aL/q\?&j])NyAo_$CN1L37(L:Sl\bkXAF]M=h]M6HrA[Y2$7(g-πU"8c]N%T.2jggapDs3Fb5JWYIrhZeK.Bfq2pF?hPh>]?n<XdCoN]^VL**_^R96g/*πU"[Tm/omt,-RKWp(Si._:2TKfPEB[X[PfCN[ZPJqBnlVq[T1*8'O-XJ[p6og'5pM)πU"0K5-5ZeBsI+38c%]R1o0m.Alm;-BQkuEnQ\.);Zaj<)%8t#R'/JcCCe0xZR)$a.πU"%JZ%nQvqjZ(qmJUdVP6W$2Ko?qqa+U^NT?5UGc[;$Pipnq7XX2_)UbdY.)D/p%*πU",_>[i?hI:;d,FQ>H('&d9XLar&_aq*uCq4Khj6AcS55c?'>NFB]P:<3*P=;ATReπU"Sfejn$6#C:b7bI<Ob8HF&[j,7=g/idXa?m+8:()]Tx.2jrRiG7S<7Y>$AT)QeBxπU"Wizli\QysD<rkqoSUsT0S(9?Dg)My5#\6]2NfyTKaAh=LQTh>:#qrwaDb1Z9hrFπU"1i_6tN1An>Ui*lQ:-m/q4EoXB3\&FGTuPC:U=$Q=g%[q&'7%&>k5=k:,\RVxK<%πU"n58vPSEQV7Y.8U$Gr-<_=1J#VaxE\2-j*vJ)7vZb0xMDkG2jlljqIHIBY&:1N3-πU"G:y*cZsj\h#*46#SAQ9B</;/4mI$[#x-:S[(]Ggy-754]uE&s%UDA_:RRNb^B+XπU"ZMW\u9/#8+pfz5h<7]l]1xBPTYj8i8k4;dR]*=K2G4X?^?q*IgpXj*0EjQ6K.v0πU",w./EG]\[cd-nt>2/.)r&Nr2'kmJ_YN\,5e8aWGLgtmS6un(Gku,DTj,jj)CAcPπU"j%FE8+?(O$d^T#MDTdo;<h(oh\v.m6P\pUdTCI=z+RJaXi6H1=oxu\/=7+J^7xHπU"SZieIbC0tE+__tbO=yR<sR)oIqNhB>u2w9&&NRH,%>$Y:?xA?W'\[?D6q3([hG1πU"RKX)fxq+HS#/ds3P#LMNh2-6m8Gp$7X*r]GI&p#>JcIg5:&WU_A0gySmRsSULh*πU"O9/CKbGUYH>J_intDOnf#&5Z*VfyE:7A82OR&;j*DC3<;X]?(O(jFdII&OQSG##πU"HFG,&2J^4husnrZ8?]u,a]KPIIk4M_EOS=kDeCw96CN>LGF\B(u:d4DYbT,z4pSπU"1MP2*vY_bT&5/%_DyMT#+,.6cp?73qWAfP-9Y,I#qJsD'$.6-&2)#LyQA3Au3:;πU"g+BT[jfz?mxt$mi-iM<TZJGvckHAj-v#S&&D?kJ0&YQ^(>/)xFiuEO&waN1u3AhπU":Z,,Dbul4Lj4\)Vur[xSd&[^^_Xd(l[j%&(jo&BCHU5zJe;h>%mPdMMNs9:L\NlπU"rb.Fc^TFt2u=XA-cdGa4iCDJ3Ra_*a$Hgqq1Q8&icMxE3;zT0]Tndk8f;]pI?]HπU"cW\:Z=U]xCt*n]c$u9wFe+HA;.;:[mgywC_8,tGS>>4lMtI^i7&yN6*U&*Ox+?=πU"syZv_ggR-dK-CB4oS$iLkn%HM0o%f\/x4*g=FM;P'9V>Tl,$Nzj2p&'dUpt7QXFπU"i:?'k\39)Y4EgGhMkd]:w=kWe4d+lAI#pHruf=F5OI%kV=-h_2Ve1W:rD[f)4N2πU"sfg^g'd,i_J;&yruu&BWD3'#=g=:WN]-#Mu=1<9H]srD2YBh*j1u'\/(<d$ZR,fπU"?P)53D:l7z-++dlHjA:UI&Nh*d1<hO\B$-n8-2D8/\YS/YUyOPfPRc<ZsNGUva#πEND SUBπSUB V4πU"TJo'E(0?Kxb84q1k\^0kbUTab8()G0-drD6pmlk0KHNS,LW_:X((o4JaWn(k0)#πU"ylBhzax]]jOfsrj7^OzB=0lFUY522(*'*bD1$DdMn0A0mNwEoSd]13H6BCb>zbJπU"yYS[/*euaC:_DzH)?ev#_.JT/8?Ys)a:ur;/pw9UG.=:+:Kb/=wDb[cnR-kr,7>πU"d&z.IAk,i*1<6Q<<=T3k]ad4A<AMZSQlZ:/lP^Jz&#,v2rjXjAu?vf_z0$J&;ZYπU"iv/2y<'9Eu,r]+SXyv:Dq0xh6?yU9vTBzL4/;Th2F_[Y>Y=R:qNC#<%6hxk0g(PπU"cYZkCbIQ2;]TZF$:ks1OPL)*:JaeHPSHYjG\cOg0?Z_7-Bk=L+[:d?thK,XIrZoπU"p7mvHvl=nT*v'wi/)KfA7AMCHID6JAQChl+b?nBt7rtfTj>MDKLCHw-$0M<X^QNπU"2_HDPcoM?lpZh.++wI't,dRh5]Wl?B&^qps\Ne+pzwS&\F6_;OQ%;lRs_QvK;D1πU"FhEHETLJ6,=KS%7s,#+#MhmHoIYckN?G=4^iC1guEVtCBX,:=*g\yY/gMCh(bL\πU"fv3FW-AsKZJLrUDyemtN[hmYr*-2P=,\\Qo&<RYlka(Zn^i(+:hyDn^U[,1,llOπU"#'<4m4s?vdS4b&H>0uL\tbjqksNF;BAVTd9e9bv*nXB7=l87MnsvLP,iOT^(\.ZπU"[:lH1fhoEE^cRK65l8k=vEo&LXW+b+4?E6AYAZ4wOo$7sarmx:k<ac/f\;=Bd0sπU"j%>8hxf12I3A+DNM$Dzee8hDeKO<N6+]\<X>t,W+#)1w(/ZrDW>J;rWn9*\uO^qπU"<QCL?E1zLf_8\=M<=JV<t&B\qSPT0D_$4xYg(ooWd8AsFZUBsjfM?CbcrOaL(&<πU"RAo\MUcUPOS57.A>=;N7(Y1Q#-lgG1>SsXuKjHTMHZ0?Npl&T3=EMZVPi(CNy#iπU"U+?:<O$VOf&)ar]EWy#lG)&o^q$&<ubN_E8o)Qo\4G$lO<#TZynWcSSZWMlw'K6πU"Oqo-z]Ja-/_x=0CXvC[=]i=N&Ug&uDuUc?d0)CDQtZ(Sdt;ofR%c-OUk)3HK3LBπU"s$Wdq=?jjeu'.:.Tc7SSnyk(ThHtV#,:8z,L^]P<^/KM_-_w,gG=VoJG=MLF\2cπU">emE=<JSYfu#cd-g0)KVZZr9wH*Lik2l(txR^Z<Vt&cvy0*je8;eIs/0=.8+?J]πU"?yx+f66#^ODCgEKmKAbUMTq=5UKn[PZy1Ik,8D?gV%\eLq:AK3TSj/gBJEq\[_NπU"_i,:h3R8T6c6VFR2>]>I.<0wn\:j,gVPyFhE8hVX2\[NPo?&QoP2q7B59U?X>n<πU"J)+yplF?p&xDaC-s3A$2x$?UH&Nnx#4NkJl#H)-DekgL1-obFMVu<dD<U0VZG0PπU"2kZ?YVXh/u;xs%4B<>r^F6JVP_Zm9IS-#r^J4aUgB/+1H9Max,W;vhStpv-rVZ=πU"#n]zDTQ%mtdsV5&tuvd?;JK:iA]d3rq2HlJ(rn,VU#B$UCQb>jDR$q1<sx.-^,jπU"\8),r;m_f$F/9S'dK1,]Q6K]'q7bFAKA&,:lfAj:%&G:H;3vh$452uga^o-5<<TπU"$d9AXjZae+a.Kvi%1S=t\D=:N8FUc-_6=j*^uX#Q_I3SvN;s#ja:F;(Si#PCo1?πU"Snkm#VNSS0*iPAxK/6)KR1Sf*ZkWEv.+Trk9#lVt&\VjuU6uHE[wG=V[+r3u<&3πU"GtDm^-,2Sh?S3F.'VCq1z,=0g/3e3&#;l-NmJXta8%21a=oLVR$jU?AmXbx[ZjfπU"$GEM?9N_aJWLu_6CI:N$CVA,>hDJ]#ST\(1trOfI9nf5DA8PHtJ=wJ3mdj\l1gEπU"x488&BwviRb=&py&81FRn$=m^IN^K_WiUEuK5Ch+*9(#W/t-:j0Pe9_5)><dqBWπU"1^f#A.ST\,d<g4XQ9Oz38lG_ZK'K?KWliZVsa<?n5,#&VgAjFiDKC-.?:a^-$7rπU"wh+*C/^%Rj38XHKFS5bijoWb-#tt+;0AX[Ra*UDMv1<mZ:5KZj?F,B-HT:>k]#QπU"1[zn6#ijt2#[N(jTrlE=W7cm,fmmJS6K4Fk#<J'8y8TyCKyE,iF&_QmzfpTY)vZπU"#T8lFT'8PvSfqt=+hvB93m'L<n[k>__+OF9xA]*\IEB5McBGuqhOVdzITdkN/2$πU"\J_'Uet\$9sz,Uz'\,-ak0\cAA2mVJX)871tX=;b9S=YR>H\<KJ)e(]#AStM/m+πU"-Xtdu%p()9%%%%-1%6?:1F]LQ,w,:%%%%g%%%,%%%%ufq%SithNfkJ_dAlL#8*;πU"+ta<DTRH?Q+)XgoVXZVjWm?&Q;=$X2J&F^VBF(L38guJ4L4s$UEm;II_s<dS=[7πU"/urH9Z6Cjlj?49.*[^5%E5Uz&x'gC5/eYh1vPONFA\'2.MCH%Zrw36ioDFK9bg)πU"nOVk6F_=uD8lgwDpl(4NdQ(Vd62[<N?ld4=VH;Qh2V[LgIH/c_)83L85n>ts2r#πU"s*or$(%QqdR6hfxA3P/itJBi9L$.QET\Nk=uqik&+Jirr[-mk:NP6gS5f)^R;#TπU"Qu.2?-#Y2oC38cxYcH$SjT\'kG8(7Xkw.:#lY+[q&wxMuses#D,k$^cG6qGnQ$,πU"KYjDZb1OT\MUdgqH3'c0TeRi)U\ZMr-'MX3'dj^g8gATayK=j-qo4h=+P.SNbm$πU"cu/.b&jJp29+SRE'9a=Um-lK;8q>2giF=jGiU:P8wH2mi_4'p.gNrAe&6F6H3MVπU">SxI[B&b3dIQ2i$R[6mx7$f;aXDZ*a%8+LN+7JBOZ(<ilG8Cz9j4ZOh%5D^9ol6πU"cz=S<Fle)EExv(4H^)j5Za_aZ5\R)I0QHd7G7jh5)l7K&sVf52W[y*Y89-A(,wuπU"*;5Fv:7&$u)IfOFgy#]D&KEaDG0Fxa:L83'_0&aX?X>DhL&.$M#zF%aVsIl+(N_πU"-ogOzmiTv;#l,ClnxejYSd5I*vg-ZlmJ]*<of?i<&Q+L5k&OY.dna[UP'Lt9$EVπU"ltJq=87;nD_IEehw5cDI8Rxu65Qp_d^EtH_:$YK31m]H$(aeSFs\vJN_wyLs:ObπU"T)ZVYtT;e2-rFb'<;vcJ2Ar<Rd]i:6?:M=UU->(O<ijV>;5Z9z\G1t_uo/2M+1YπU"0iwXT.io%s'-OIQzu&DdslBK;TV-#qZqxQtWaC%kqj/-6]fK89q:(=>BWIP9KcCπU"rH7:BRGxZ$\ca;DpuJDK2>$u=SXOMq(6.7vREA7N/S4^x9^L*/D_+Zz5=Tik7DmπU"kqn&k+w85$UGFTjnM>WHiW?7#rY<0li%Mnt/43'4kY'4xU.#wH.Fj>[W3D$,i$2πU"7t9e33iGV\s[O<f.<G78WM[W7CMWiXIfi#Ld=wsBWU*E4:NsvCyyp&F[\+.4/NYπU"T),jjh<&sf9k%j%lJ)7%xNwA(t(ZL6w4Sk'AhX9k/sM6JA$AFx2)Ho'>3?+7mh2πU"c:*(f<GG)93wVk&=Q#<&uM^Bcg^s$]zI+4BAdZ>$q*hlfFD%LGxx*aLqPd&=KcoπU"/Pi%m/*(9i'LVqbcjZYY&sn[p.).JF/Ythj\lYg'1gh.Hb$[zt%kMiyc(Qceu>7πU"]DK;twEPv%g(K[yBxE]8+hB)K4TWp$B7UR#4BOoLv9)j_ZjKn;EUYs%\jcC%/XqπU"f=G]DlD3lXy+Ow\3FA7Xm6QeV.*jCh]IHLU\).%f80sOP5)uqJ:?u;g>CkM_95mπU"e;3R[na?\iU;eR?>1XA+33+2;85-.X79Igirw&'0<DA+lW\Le-I\[11ZU14MπU"\e/&tBem*N-UgQ,Gac1rjd,XF6ID]+^St/&SFKf4N-[X\kF-,xgGL/&CrN5Osf[πU"c>N^'D*0Q]Q^1[zC3VaQAr-M:0V<0z8iO+(D,T_TC>BrN[zZI^ATV2(,-Ez73ldπU"U1.rlyppovS)RNuwFP;Yq?kJrPkqCXcX/h=.eor<4?O9&aw7ONQ1<B]00iMqEa-πU"'S+\<L^JPIXEbCILCa8Rc/d&gmidiKfo.iLWpKh;Y4L;em+sCeh?*6]Prv.=(=?πU"/oRz=bfki)=Jy/imsTV%%Y5m^(%VNihSYMG[AQYy]E87g7*(9yvEly-8hCs(:^qπU"GYP8<s)<gr6Q2r+aMdCyCw-G-__8g[de6I'sH#N%A+zpM9nA0]]j8t/j?>%q%zrπU"/wdhk6dFDwHZ*<aDH%x+PT?e:/#fuleNzl+19t2G,7sWzK<*rIQO?pxp/>1-%FMπU"H$i+C6adnrq'\#zjL(?OKm(lf4PgBB&Sf*Qa?L3?4o?;/?[MbWy-g$KGU0pr50rπU"LtKU8_Cbz&SEfw7v7/0sv3*-Bb/e+7m\Wv3J43fW[o5,PdM,c3+l8#V1h?[+mK9πU"m:k/DI5a=3U*PSK(JTQ'Shhb0e%J&DRO9e+;B#A?<>:7I2D2RHQ/?rD,+o>2I0ZπU"w4Q#kRO;kgnDLh3x_?gUvieDxn]X4gswM2s%rEtE=K7h)$35ZhS.zmX7h^r^h>KπU"H:Ka.$oCGugKYb$7x7[,J5O)8bGNkX>wYRnVPUw'3jY+l=>+bp<3s89(h&HN:hvπU"4_;>o_9I:?1THh(bZ-3+NhGf_Bd0'zejE]X/($4i)Y1_X[Q'bykfsE1XNu>BQKOπU"OP&aL'dTy-Bp'T8u><0tz+#QCp7n$kiYkH,Z)SFfovikOiQ4+SB?jA;Kc=M%;sjπU"HK,;O7bPIp6unhNS4GLkxptz=Si/=5TR+Om1j:n^%J,ZT_\Y#8<NMt8a#o06xL\πU"tdlo,x0bBi'^UDu6GZaz>TIQL*1p(uGCD(4*ay,0w;>(N:#vUc)C_eeEZldlo%NπU"F[Uf^BEqSeh667%FIlUiNk[(bo$,5IlN-'M\5>M[[ORSr6u:XQNX_jtk(Fz'qvbπU"ocfJ'6NEAzb\iK&*/Z;K/?bHKqnL]Z=e:+8m*)2:EcT&xd_?prv*NA;-)G,4^-kπU"v7_\#:-c1&bmlAGmh<MbWhNH#qsDh=Of$hOm>xG1hL0K3#vvXlLGuOtD.toM4_9πU"C)lg,HEZIW[JVlBKup=mqK]0FjAjHJKu\R7*&$z.4/h[8\JXZz8.qepAIca*(foπU"yqvh%9nfa#TZKef'T5J;z,$m1*lXb)2sGXsHGv4VTQq5iW0$\SmjbAZ\\.Vm(e^πU".l+_V6oKt:Gd9o:ACOpq*XSJr&,]WfhA^V*j\gJ;C?<Z)6(ksng[Jv6(xBr\jiMπU"sn&*A.B$p:sO(7l)XJd^XQWu)mrppyJw_%+LEK?$L)/d8Mg(BLFmS+XK44z1-rGπU"hittao+'&e*dlP)v-Z6\(2FfFD^x43hyoF9FPf%=^gLR1R68:mBRBwPmIhqiFC/πU"O.)F>O&<\R5LRcD03gj3[Ha7VAdS08X8iB,y+%RXil_KH1elATej;?WPp84V/BgπU"ye67IZrd7J?7p-3JAD4R%z'o6&l>H;A?2AY>0xEi$YJh'Q:^qJ=h?E>IZ4^HFOBπU"jiSb\#_;v;6wA#>u3_gBc%4rmO',B$?$m^.cX4jcIzK2=-Ng/RTvn:1<N+V4*KdπU"rX+wnm)VLI7]bhP[>.OW-Fah#?/r-)#<3Jqhy4k#AbMY=\0ic9Qt&-q$z;:<$]PπU"ko.zN-A?,N43f5O*Xlg5,6*(p3A.erkOE'Ps+m%>CS$nb8e(,6l59K5%leT?Gk[πU"zt&n0#hCHu=5VL?^S-=BFow=6_Mi$+eUk.=hNK\Zl_<FCga<&oT66vkTemRQrπU"jhRbx:(j%[XutVHIbTRYC_HRN7SCn-<H1=;DKbk(X<#CCuB]XbvVb.Tmh*J*eI:πU"R?ImA\).<:6bD[CNVHbXYyO-PfP9Vk'b?r[aQPKciF3T=ciNZ2t4DGICCKQD:[NπU"w<a7xDdKwn[;iW:4Hb^HqFsCg+,3P[k:lF=lUuxK>KKZ^6=MKIFNtS/;(5hE0>VπU"s*\z^2d8#TE9dsj'm:l;?NaxNO]R$A;RyT-J.n:+SDMKs2bXAS^:&z_)ig'JvFlπU"sJmoe2uXkD%W3EHfGuOxYF80y&m>l4ePZ7PqN&\3AlL/bX]+#tfDX\s>;i$e^PgπU"JKguo'_?bvDX^r>M2+2D,&'_,ZORJ>ne2as/P&FCf>%8vZ&Ir-'k;B=QHB554Z[πU"$DS^m]'jOaNGmeEuo5K.OTb]*qlo./qH3gb2pY77_..p+,mSCl]EaV3aL6NgdnRπU"zmh:\Yq/\xyZu\Ri444Gfo+X4N;RG<p<CM9;v_:-Rgu<#NP/;MI$_%J#[$c:_lNπU"kb7-Yk[YDoQHF;[LBh'N-v-lt=osv8*ulW&_fjkibHH%k1Zjge_X6xbYh#\V\sVπU"fb%bS^Vfxf7YJH,g1Oy(+GspWCJBKxv0M5'a^Z<Z>(JRRX?TSTk,vSsWX=PSzDVπU"CM/G=esF(ZXG?j/+$BgCdkIb?cI.0WI2q8us?0:PqR\Xa\bsY9/E[6Pms[j$g:QπU"sibZn[.iVBL166[mL<[MBdR$;uHl<_Y+2XGFHHB4=\b,hlq'Bmr.tGKKu2juDn1πU"0nM\(Pjt8l<Ct'dmNVzjV)Jhpjm;ew6RW8uZ_1C7'zHfLFB:+.lgIt\sJF'6VAVπU"lQ/nra.45C9gw'Qj[9rAFAtLkNObA3=+2]iwNsGrv5a?iNh.:0(apobnKo7+bc3πU"<+lKoq+lZ.dt$rr'IZU8w<JynxP*Tch%$Wd\$VLK+JmIsUg9D;=po1MK*_8s.u#πU"34?Y7PAG)yz^?<VVBO#pXWrQ6F7[qa,(jKLS/u0GYyz&>mh$,'>r1X0l+URgZE8πU"&,ilgeCGz4<5ZK(Z3gVW\\AL0iHa\(/j[riKAHj*Tp.fy$gfo-Gh+AkM'_5#%isπU"6RX_g,q&EsAzuFAV.3;(&1YjQsVYO2GhjzP_iA31/%HMZv:*d69k>IGR?Da&iD/πU"xCxI^Y:Q4ovttv>#H/9sT81fTejgeMVGXU^6M)p+lqaTA(F4xbu%J]px:UBoEoIπU"qW\_&9j3bc/ssEV4nu^4fHR$4;'HHw<)\)7Le$If^HM<VBA7.wVQWM^6t>/(9fBπU"60ZWAS_Y$u3v-TemSI<$u7=(f6D<)XG[IA<]#8NP?yR/'IQs/yzxZ6CcgqBF3d<πU"QJ.C[jiBdMcpNoTOHDG$X9(SfOR7\&t4x_VJ-c=D;,*Fnj\<BVr'v?\R_7FU>&NπU"rMm0>A1hp+v4?uVg4n(:EJ:fZnX1>BYKWq0Jy#=tf*hr-gpA$J<)iDoa.PrjKkiπU"A+%%5s':A%/r:>X<4)rW(JrSungfj&\WCP6]]:aEPamrk3]%UJxE9#fLUYoBFXTπU"F/rj9J]e_A)$GY6fDwFwBlqiK8=d+j)[1q>VImZjC/]emnSySF#W7&\4OCByst2πU"&MQX>K?dTE>ZZeC-<vD)yyVmYg^1AeMh^7,[rmkjFW)*f3j$XC]5jE3Z#n;wr?2πU"YV-PG\;uQ8gj2_$0kI[bVn5N:DAEysJiFverQ;6q]+SB#f3bfkqVT$hY.XvKc#YπU"AKj<wMlrdTohX0iQh5DqS_H?#kZ]u/c3D>cDtUrj<mHhd]a=GYlo'1$+LZf6$aPπU"6c[+fZ\oil+.2)G?nzrG&_0W,n\l;o?r(0+H<fc;:MhUW:>+ro:vbt]_,%]K8sdπU"-OxwaEQ3?W%nIk[CkyPsO:-)5?r.i]wEVr^]9jt2^tP%qDoq6K:.5^WpcdmT&eFπU"k)rhq15b+sN#Z18-WqVLtS-*e<,J2z?,sQ1?f_ja64]EN)[Zk2Op=g_Y*^p<$diπU"KV,dA[h?\&4cPd<F3j+a8#AtpkWg%Ym$+07YED?MnNg8l7^3W47c1g,:4O8^k\*πU",TC=j'>U#/e-Eiv323pO6:4>t,UF&g)F\Pt:fWhTQN<*n+D=bwQHU4N\:R4bituπU"8xuXQW#MJi&Fl:s=vkctqmtKQoX*Itm(w4sdu?wpcvhraUTnf2NJy(ohonY=Ci:πU"ZcmZXY$D*>t:/G_[r?m6FHcA&?F-]t69e/YGor?ql4&?-49W-W)0g%>+8>>)_0nπU"MG1GGT>*F'(,>C)n%nI)XR[iFP4ia[i3iC-G9kKv$[,+,',29i/i_9iviV<iLi(πU"P?Zh[:.?uqYyhhN[DD4,_N44*9t>tA6te6dfDch/o>,RVWmD$*j[O=_s_pqOhlTπU"n,ToT9EtM-dwWDv.Nr,Ero;Ppf(-<T,kT/4mUrQKaebMT;/jsEBTsFGW?l/qf)_πU"Bi($Y%G1KM3/73M/G3/233/dlNDz:c\Y.ifmB[FJQ<P6>n>QS0iA?>#='FGC$GLπU"':]j*H9Y[iO8?\qNBq4UNg32ZYuH9d9a#9L9885C&%*5%*%c)c'Bg(4Rq._Y$FVπU"oq?a9U)WF'w6KU.k*b9*#9a&')T+L\QfOMfQfPDfR/GaT1#U[4C%xj+/mH-Q,%,πU"]H,'u^.G21+,U4C%%d&dF(TS/A;=qQg7wOTo9$:4o:<92[<gC)+-W3cF2g(^SRLπU"9Niw_)[N48ZKbZvO(K/[MLldGNwrhbxViOqf)Sjm/.DO,t63e)?B0qb?A'U0c)%πU"c'c/%c+C&V^Q$-$='CeF,84];P*9BTYbYL<Yn9X_mPUYb)i?iaEq^qXJ1a1'?S+πU"h'Y+Ef#BA,FMR>Pn2R.Q0pS0eb/o1--J=+FQc49<:^dOl:k2YJYb#i)qd6M-C3QπU"do'D+?#GF:1#KC#K,k9xq?S+)H&,AO%z?aP1BU(,M%sJN;2JZ:nY59i3iSiiH?sπU"',>#%%*u)T7%:ioui#Y&TYfi,e?;6e(A?C](D+-S.'<RpZ:(ba_cf4W+/W3CO(2πU",[[^E&((&N&c+37'CI)tO$rV[2Yasiri.U=G3Y2\Yt<Y4Y]9qUqpuihY4D/;42)πU"&P.EZ:&YE9i3i5PGS4[Jl3A/7.)YrTY3i#?iPYxTYLY6?YKD>04;+,G+i&?CTG-πU"KC:K,;1D1;4B1AqQ7d%()0h+.(%d&d(A63X%.%j?H010K#AK,1]aU/<]AO(/oa-πU"')t69N/d01;+,B',8/#/A%V'9W]+9W(W,9w/u09q6qVC]>T2g\O8iid9NC3d5?TπU"9q$i2Kir_NLS2&OaJi>i[E]$#'Qfu+^/K?ua=u9e0EXE&8GCqh9ilYxTY0YZiYJπU"/9)0;51qP*:f0Y]GZtG&L*%Td-//&U%)fh*^L)LPV&'W1c&Bg,4ONlZ[,a-'nf9πU"J^I'>>a,r%d2c\:+H?ws$n]Pt^R\eU6J*>l+(Mn2M+3XW).^D?kr8bYI8$fj$p=πU"fHvtJL=N-XZu/euZdT[_s9l>ToPU;([sB9VrXK=ova2/xS?;QP$Q8rvi?DwH%=<πU"0hSA0j[G(3*1Y\n4g/Qv^;pd:ycHZGYe_WmfRH,Gb*wqjDW5m/iAQ_=E?TE3d7TπU"Y;b^LY/Ym&r6NYmcT9>eC'52jsXH)VMaM_nD-6td;55C0qKIuahK85+N=MJ<-ksπU"Du%p&'9%%9%%#%-%r&?:FQ7Wv'o%*%%K%5%%0%%%%%%%%%&%%E%%%%%%%.%j'f%πU"ruqj%Sgfx%up&'%9%9%%%%-%(ha8F(P-G?%<K%%+kk%%%,%%%%%%%%%%%E%.%%BπU"*%%%uf%qSvq%gup&%'9%9%%%%-.%ha8:F5rr%jFK%.%63%%%,%%%%%%%%%%%E[%πU"%%(%P%%u%fqSq%ngup%&'9%%9%%%#-%Fed8F[<:nfj*%%%q5%%%+%%%%%%%%%&%πU"%E%%%'nv%%%ufqS%gnup%&'9%%9%%%#-%ead8Fpd2pjc9#%%o%%%%,%%%%%%%%%πU"&%%E%%%(/'%%%ufqS%gfxu%p&'9%%9%%[%-%V&::F6.lv5D%5%%#%c%%,%%%%%%πU"%%%&%%E%%4%<;%%%ufq.Sy'y%up&'%9%9%%%%-%)6?:FD]LQw',:%%%%g%%%,%%πU"%%%%%%%&%E%#%%,L%%%uf%qSit%hup*%+%%%%%,%,(%E&%4%Xa%%%%%πEND SUBπV2πV3πV4πCLOSE:IF S=70AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπJonathan Leger                 USING EMS WITH MEMCOPY ROUTINE [e-mail]             07-11-96 (22:56)       QB, QBasic, PDS        357  12711    EMS.BAS     DECLARE FUNCTION NumEMSHandles% ()πDECLARE FUNCTION NumEMSPages% (Handle%)πDECLARE FUNCTION GetEMS% (numpages%)πDECLARE FUNCTION EMSPages% (func%)πDECLARE FUNCTION PageFrame% ()πDECLARE FUNCTION EMSstatus% ()πDECLARE SUB ReleaseEMS (Handle%)πDECLARE SUB MapEMS (Handle%, block%)ππDECLARE SUB MemCopy (fromseg%, fromoff%, toseg%, tooff%, bytes%)ππSCREEN 0: WIDTH 80, 25πCLSππ'**** Show some EMS stats.πIF EMSstatus% THENπ   PRINT "EMS installed."π  π   '*** Open up a 12 page block of EMS memory and store theπ   '*** handle info for later use.π   EmsHandle1% = GetEMS%(12)ππ   '*** Store the PageFrame% segment so we can write to it later.π   EMSsegment1% = PageFrame%ππ   PRINT "Number of EMS handles in use:"; NumEMSHandles%π   PRINT "Total EMS pages:"; EMSPages%(0)π   PRINT "Available EMS pages:"; EMSPages%(1)π   PRINT "Free EMS memory (in bytes):"; EMSPages%(1) * 16000#π   PRINT "Page segment is at: "; HEX$(EMSsegment1%)π   PRINTπ   PRINT "<press a key>"πELSEπ   PRINT "EMS not installed.  Aborting."π   PRINTπ   PRINT "<press a key>"π   ENDπEND IFππWHILE INKEY$ = "": WENDππSCREEN 13ππ'*** Draw some stuff on the screen.πFOR x = 1 TO 100π   CIRCLE (159, 99), x, xπNEXT xππEMSsegment2% = &HD000ππMapEMS EmsHandle1%, 0πMemCopy &HA000, 0, EMSsegment2%, 0, &HFA00ππLOCATE 1, 1: PRINT "This image has been copied into EMS."πLOCATE 2, 1: PRINT "<press a key>"πWHILE INKEY$ = "": WENDππCLSπFOR x = 1 TO 100π   LINE (x, x)-(319 - x, 199 - x), x, BπNEXT xπMapEMS EmsHandle1%, 4πMemCopy &HA000, 0, EMSsegment2%, 0, &HFA00ππLOCATE 1, 1: PRINT "This image has also been copied into EMS."πLOCATE 2, 1: PRINT "<press a key>"πWHILE INKEY$ = "": WENDππCLSπFOR x = 1 TO 100π   LINE (x, x)-(319 - x, 199 - x), xπNEXT xπMapEMS EmsHandle1%, 8πMemCopy &HA000, 0, EMSsegment2%, 0, &HFA00ππLOCATE 1, 1: PRINT "This, too, has been copied into EMS."πLOCATE 2, 1: PRINT "<press a key>"πWHILE INKEY$ = "": WENDππCLSππ'*** Show the first image we saved.πMapEMS EmsHandle1%, 0πMemCopy EMSsegment2%, 0, &HA000, 0, &HFA00ππWHILE INKEY$ = "": WENDππ'*** Show the second image we saved.πMapEMS EmsHandle1%, 4πMemCopy EMSsegment2%, 0, &HA000, 0, &HFA00ππWHILE INKEY$ = "": WENDππ'*** Show the last image we saved.πMapEMS EmsHandle1%, 8πMemCopy EMSsegment2%, 0, &HA000, 0, &HFA00ππ'*** Release the memory we were using for the demo.πReleaseEMS EmsHandle1%ππWHILE INKEY$ = "": WENDπSCREEN 0: WIDTH 80ππ'************* EMSPages%() ****************π'*** When func% is 0, returns the total ***π'*** number of 16k pages, when func% is ***π'*** 1, returns the number of available ***π'*** 16k pages.                         ***π'******************************************πFUNCTION EMSPages% (func%)ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(180)πasm$ = asm$ + CHR$(66) + CHR$(205) + CHR$(103) + CHR$(139) + CHR$(126)πasm$ = asm$ + CHR$(6) + CHR$(137) + CHR$(29) + CHR$(139) + CHR$(126)πasm$ = asm$ + CHR$(8) + CHR$(137) + CHR$(21) + CHR$(93) + CHR$(203)ππTotalPages% = 0: AvailablePages% = 0ππDEF SEG = VARSEG(asm$)π   CALL Absolute(TotalPages%, AvailablePages%, SADD(asm$))πDEF SEGππIF func% = 0 THENπ   EMSPages% = TotalPages%πELSEπ   EMSPages% = AvailablePages%πEND IFππEND FUNCTIONππ'**************** EMSstatus%() ******************π'*** Returns whether EMS is available.  -1 is ***π'*** returned if it is available, 0 otherwise ***π'************************************************πFUNCTION EMSstatus%ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(180)πasm$ = asm$ + CHR$(64) + CHR$(205) + CHR$(103) + CHR$(176) + CHR$(0)πasm$ = asm$ + CHR$(139) + CHR$(94) + CHR$(6) + CHR$(137) + CHR$(7)πasm$ = asm$ + CHR$(93) + CHR$(203)ππEMS% = -1πDEF SEG = VARSEG(asm$)π   CALL Absolute(EMS%, SADD(asm$))πDEF SEGππIF EMS% = 0 THENπ   EMSstatus = -1         'EMS installed, set to BASIC's TRUE value.πELSEπ   EMSstatus = 0          'EMS not installed, set to FALSE.πEND IFππEND FUNCTIONππ'********************** GetEMS%() ********************π'*** Function returns the handle value for a block ***π'*** of EMS memory that consists of numpages% 16k  ***π'*** pages.  You _must_ keep the handle value for  ***π'*** later calls that require the handle.  Example:***π'***                                               ***π'*** EmsHandle% = GetEMS%(5)                       ***π'***                                               ***π'*** EmsHandle% holds the handle info for a block  ***π'*** of memory 5 16k pages in size, or 80k.        ***π'*****************************************************πFUNCTION GetEMS% (numpages%)ππ'pageoffset% = EMSPages%(0) - EMSPages%(1)ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(139)πasm$ = asm$ + CHR$(94) + CHR$(8) + CHR$(180) + CHR$(67) + CHR$(205)πasm$ = asm$ + CHR$(103) + CHR$(139) + CHR$(94) + CHR$(6) + CHR$(137)πasm$ = asm$ + CHR$(23) + CHR$(93) + CHR$(203)ππHandle% = 0πDEF SEG = VARSEG(asm$)π   CALL Absolute(BYVAL numpages%, Handle%, SADD(asm$))πDEF SEGππ'asm$ = ""π'asm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(139)π'asm$ = asm$ + CHR$(86) + CHR$(8) + CHR$(139) + CHR$(126) + CHR$(6)π'asm$ = asm$ + CHR$(139) + CHR$(118) + CHR$(10) + CHR$(177) + CHR$(0)π'asm$ = asm$ + CHR$(48) + CHR$(237) + CHR$(180) + CHR$(68) + CHR$(136)π'asm$ = asm$ + CHR$(200) + CHR$(137) + CHR$(243) + CHR$(205) + CHR$(103)π'asm$ = asm$ + CHR$(70) + CHR$(65) + CHR$(57) + CHR$(254) + CHR$(117)π'asm$ = asm$ + CHR$(242) + CHR$(93) + CHR$(203)π'π'DEF SEG = VARSEG(asm$)π'   CALL Absolute(BYVAL pageoffset%, BYVAL Handle%, BYVAL numpages%, SADD(asm$))π'DEF SEGππGetEMS% = Handle%ππEND FUNCTIONππ'***************** MapEMS () ***********************************π'*** Sets the page of a memory block (identified by Handle%) ***π'*** that is located at the beginning of the page frame.     ***π'*** Example:                                                ***π'***                                                         ***π'*** EmsHandle% = GetEMS%(8)                                 ***π'*** MapEMS EmsHandle%, 4                                    ***π'***                                                         ***π'*** When the page frame segment is next written to, the info***π'*** will be placed starting at the 4th page in the block of ***π'*** memory represented by EmsHandle%.  This could be use,   ***π'*** for instance, to store multiple SCREEN 13 images in one ***π'*** EMS block, by moving the first 64k image into the first ***π'*** 4 16k pages (16000 * 4 = 64000) by using:               ***π'***                                                         ***π'*** MapEMS EmsHandle%, 0                                    ***π'***                                                         ***π'*** And then putting the next 64k image into the next 4 EMS ***π'*** pages by using:                                         ***π'***                                                         ***π'*** MapEMS EmsHandle%, 4                                    ***π'***                                                         ***π'*** ... and then moving the image into the memory block.    ***π'***************************************************************πSUB MapEMS (Handle%, pageoffset%)ππnumpages% = 4ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(139)πasm$ = asm$ + CHR$(86) + CHR$(8) + CHR$(139) + CHR$(126) + CHR$(6)πasm$ = asm$ + CHR$(139) + CHR$(118) + CHR$(10) + CHR$(177) + CHR$(0)πasm$ = asm$ + CHR$(48) + CHR$(237) + CHR$(180) + CHR$(68) + CHR$(136)πasm$ = asm$ + CHR$(200) + CHR$(137) + CHR$(243) + CHR$(205) + CHR$(103)πasm$ = asm$ + CHR$(70) + CHR$(65) + CHR$(57) + CHR$(249) + CHR$(117)πasm$ = asm$ + CHR$(242) + CHR$(93) + CHR$(203)ππDEF SEG = VARSEG(asm$)π   CALL Absolute(BYVAL pageoffset%, BYVAL Handle%, BYVAL numpages%, SADD(asm$))πDEF SEGππEND SUBππDEFINT A-Zπ'******************************* MemCopy() ***********************π'*** Copies the number of bytes specified in 'bytes' from the  ***π'*** memory location fromseg:fromoff to the memory location    ***π'*** toseg:tooff.  To copy more than 32,767 bytes (max. of     ***π'*** 65,536 bytes) put the 'bytes' value in HEX form.          ***π'*****************************************************************πSUB MemCopy (fromseg, fromoff, toseg, tooff, bytes)ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(30)πasm$ = asm$ + CHR$(139) + CHR$(70) + CHR$(10) + CHR$(142) + CHR$(192)πasm$ = asm$ + CHR$(139) + CHR$(70) + CHR$(14) + CHR$(142) + CHR$(216)πasm$ = asm$ + CHR$(139) + CHR$(118) + CHR$(8) + CHR$(139) + CHR$(126)πasm$ = asm$ + CHR$(12) + CHR$(139) + CHR$(78) + CHR$(6) + CHR$(243)πasm$ = asm$ + CHR$(164) + CHR$(31) + CHR$(93) + CHR$(203)ππDEF SEG = VARSEG(asm$)π   CALL Absolute(BYVAL fromseg, BYVAL fromoff, BYVAL toseg, BYVAL tooff, BYVAL bytes, SADD(asm$))πDEF SEGπππEND SUBππDEFSNG A-Zπ'****************************** NumEMSHandles%() *********************π'*** Returns the number of EMS handles presently being used (there ***π'*** are a maximum of 256 handles possible at any given time).     ***π'*********************************************************************πFUNCTION NumEMSHandles%ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(180)πasm$ = asm$ + CHR$(75) + CHR$(205) + CHR$(103) + CHR$(139) + CHR$(126)πasm$ = asm$ + CHR$(6) + CHR$(137) + CHR$(29) + CHR$(93) + CHR$(203)ππNumHandles% = 0πDEF SEG = VARSEG(asm$)π   CALL Absolute(NumHandles%, SADD(asm$))πDEF SEGππNumEMSHandles% = NumHandles%ππEND FUNCTIONππ'***************************** NumEMSPages%() *************************π'*** Returns the number of 16k pages being used by the memory block ***π'*** that is represented by Handle%.                                ***π'**********************************************************************πFUNCTION NumEMSPages% (Handle%)ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(139)πasm$ = asm$ + CHR$(86) + CHR$(6) + CHR$(180) + CHR$(76) + CHR$(205)πasm$ = asm$ + CHR$(103) + CHR$(139) + CHR$(126) + CHR$(8) + CHR$(137)πasm$ = asm$ + CHR$(29) + CHR$(93) + CHR$(203)ππDEF SEG = VARSEG(asm$)π   CALL Absolute(numpages%, Handle%, SADD(asm$))πDEF SEGππNumEMSPages% = numpages%ππEND FUNCTIONππ'******************************* PageFrame% ***************************π'*** Returns the segment that you will need to write to in order to ***π'*** store your data into EMS memory.  For example, PageFrame% may  ***π'*** return D000 (HEX, -12288 decimal), and then you might do this: ***π'***                                                                ***π'*** DEF SEG = PageFrame%        'D000                              ***π'*** MyData$ = "This is a block of data I want to store in EMS."    ***π'*** FOR X = 1 TO LEN(MyData$)                                      ***π'***   POKE X, ASC(MID$(MyData$, X, 1))                             ***π'*** NEXT X                                                         ***π'*** DEF SEG                                                        ***π'***                                                                ***π'*** Note, though, that you have to have a block of EMS opened with ***π'*** GetEMS%() and maped with MapEMS before you can write to the    ***π'*** block.                                                         ***π'**********************************************************************πFUNCTION PageFrame%ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(180)πasm$ = asm$ + CHR$(65) + CHR$(205) + CHR$(103) + CHR$(139) + CHR$(126)πasm$ = asm$ + CHR$(6) + CHR$(137) + CHR$(29) + CHR$(93) + CHR$(203)ππPageFrameAddr% = 0πDEF SEG = VARSEG(asm$)π   CALL Absolute(PageFrameAddr%, SADD(asm$))πDEF SEGππPageFrame% = PageFrameAddr%ππEND FUNCTIONππ'****************************** ReleaseEMS() **************************π'*** Releases the EMS memory associated with Handle%.  This is very ***π'*** important to do before you exit your program, otherwise the    ***π'*** memory being used by your open handles will not be available   ***π'*** again until you reboot.                                        ***π'**********************************************************************πSUB ReleaseEMS (Handle%)ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(180)πasm$ = asm$ + CHR$(69) + CHR$(139) + CHR$(86) + CHR$(6) + CHR$(205)πasm$ = asm$ + CHR$(103) + CHR$(93) + CHR$(203)ππDEF SEG = VARSEG(asm$)π   CALL Absolute(BYVAL Handle%, SADD(asm$))πDEF SEGππEND SUBπBob Perkins                    DIFFERENCE BETWEEN SADD/VARPTR FidoNet QUIK_BAS Echo          07-09-96 (21:36)       QB, QBasic, PDS        50   1973     ADDRESS.BAS ' >        Does anyone know if there is a difference between π' > SADD and VARPTR?  Ifππ'  They are both provided to find the offset (address) of a variable.  VARSEGπ'is used to get the segment.  Though they may appear similar in function, theyπ'do have differences.  SADD is not to be used with TYPEs or fixed-lengthπ'strings.  VARPTR is used with those.  VARPTR can be used with simple stringπ'variables, but it does not return the offset of the string but rather theπ'offset of the string descriptor.  From that you can determine the address andπ'length of the string.  Note: Be careful playing around with poking directlyπ'into strings in memory.  You could find yourself facing a "String Spaceπ'Corrupt" error message if you inadvertantly change the length.  Following isπ'some rambling code examples to show how to use VARPTR, VARSEG, and SADD.  Hopeπ'it helps you to understand better.ππ CLSπ s$ = "test"π segment% = VARSEG(s$)π PRINT "Segment of s$ returned by VARSEG="; segment%π PRINTπ 'π offset% = SADD(s$)π PRINT "Offset of s$ as returned by SADD="; offset%π DEF SEG = segment%π PRINT "Contents of s$ = ";π FOR x% = 0 TO LEN(s$) - 1π PRINT CHR$(PEEK(offset% + x%));π NEXT x%π PRINT : PRINTπ 'π descroffset% = VARPTR(s$)π strlength% = PEEK(descroffset%) + PEEK(descroffset% + 1) * 256π stroffset% = PEEK(descroffset% + 2) + PEEK(descroffset% + 3) * 256π PRINT "Offset of s$'s string descriptor returned by VARPTR="; descroffset%π PRINT "Offset of s$ from string descriptor="; stroffset%π PRINT "Length of s$ from string descriptor="; strlength%π 'π PRINTπ DIM fixed AS STRING * 10π fixed = "0123456789"π offset% = VARPTR(fixed)π segment% = VARSEG(fixed)π PRINT "Offset of fixed length variable from VARSEG="; segment%π PRINT "Offset of fixed length variable from VARPTR="; offset%π PRINT "Contents of fixed length string=";π DEF SEG = segment%π FOR x% = 0 TO 9π   PRINT CHR$(PEEK(offset% + x%));π NEXT x%π PRINTπErika Schulze                  PB XMS ROUTINES                [e-mail]     08-24-96 (12:03)       PB                     249 16316    XMS.BAS     ' Load/run under PowerBASIC to extract XMS.ZIPππDEFINT A-Z:SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"XMS.ZIP",4^6:Z&=11938:?STRING$(50,177);πU"%up()%9%%%R-%&Yd=Fmf3gFj'.%%f)%%%/%%%%wj%firj%SVxyIzx,>BSe5Ku0]πU"x)Rd%USVc_]x(57jz:'yLKZcTR-T<Zol\BDFb?(hU>pm:BKMHFEFk5oK8h2y4<uπU"m1C,G.D2dA)^Fd06nbYs^Hat/1_.RZ+lumoi1BfDs\:8jWC1N$v2q>_;0IPFy*RπU"\WekMYhC\aQqm9(CO5,8A$JfSh/=tt&mJzRq8Y4vdrooFe]T.9SaY+U;<5tB]<_πU"vrO?<tWik'D<Jf)Fz6sNJakp)+H7f7(Dj\jp,>I:UbW8hrl1V>^:08HpO<Uhr6bπU"1/wz8n9XtjaTCPb=3-(Hk57'&44&UUMsT;64i-sX)I:i#R13oRt5fo;0Y):hKojπU"%+j6ftT^v3oO#.z.Re/J<Rs-R+*L\sCiboK-^1Ir%#Gq&<V'h&V_f9,Mf1?(QEZπU"k+>hqz[;a&%][wCY87e89=G(K[R6PNUu00sVUi)EM<<=<BNCe#N5X]hQErTrAD7πU"GVRU/B9RfXfOT1:_XySJ-_jv=hKQY>'kJ%+G[<(O1#9EeQ.?%DBIKkIS#Cj&.kYπU"0WWfabjWHuvS?]d^o.Hf.Bv)U([r<5yYiA/\EIt'WFP=4QFjQoSN-M^rkDNw0CsπU"4xtuFG*;:dfJy0rJ6<&fm6Ka$/fNXoGCiT;ZFi,f=+/opmjIUMkr6o_m#5$Qc00πU"1Cd)I8X:*uZG?o-0?8G.;sO8f\CIUuw71app7e*qSYSA<_1Cf?hVtdnP^rVde-rπU"9i2b0003PSme:>r0;\8[=\STY?d14.*;n6,w6.\a,?P]G*Jh$>Go#_0DUq2VZ9RπU")<IYS<[kc.CiDl>w;?iUS'l#_d^$jq?5RJ7WLsbtQ:LYVVVkTiv0)$7UUTkZg(KπU"N&u%p()9%%%%-4%&Y=jF)vn-()&%(%^*%%%,%%(%'rx%SnshK&y<>]SU5wm17xZπU"+y&WmGrSDw8y'R;X:;=ZAoDBAp9^='fG3:oidJEQF)ejdPitC]XDXlkXD$=<PBJπU"8Z3n3M8ILhGNNq9\9Hd-d[u\]ZC+pu[=5..)R8$P6,90hAzCoaO^m?j<jfvQQrAπU"A%PxbkKtVLC2N?2=0:-=Ie*_#,kiUeEw62&V4C<#v4i'\r2)ad&uo.9k.fJcHm>πU"nUp048_D_^=9BGs7NFIlENDZcHS=[K#gFxPNshCdvMHP0=FQs/-:N0xRS6K_OXlπU"?NC=[sqlF_slMPpHqzYJ]6aC>d3zq\H'9[_O\'mIafq'lW>S$[8'd3;5s3XmP%*πU"^M<Bd&es>2ejBmc7bb+J*=?Eh\VyMFkkw*au,9;MLcYMBQ:Nc5=WFVDIINhIk.vπU"*iPk8KN?\Dg\Z&&L5o$0rV?IVfLTh-XwinfwD[Gj',>T(jI>iUEDf$Z%b5OvzatπU"0D-xfX/%vu=d9=r_Bg0GN8V>Qx<oAce1Xe&629FL,K#w4XE][Ml/$Wr2]sd;nt_πU"3&%[_-Lic[]GaX$z[?Dw(%up()%9%%%R-%&YR=F%R.Ld^,.%%y6%%%,%.%%'r%xπU"SugOq&f<.qy&?*#n$X+1(/>^+y6AqpYN-Y]-)zPX30c<ZtDUdQ1oJSy<_QU86g_πU"hJ6w%1FZ*rSoxD'W&=diumK3h<V=VY.FF<nVY80,4cgvrHv+[(-\3VNW?EL5To^πU"$htpp[via$Bxl$unXu2p2$9>0\dJ6s(A7%]ve84-d$)]+,om3+tuJLf.7uxl>Q>πU";ffAF-m;UnI'VQ7P_I:fc0/<%:12)s/*JOm#-93Le>>wu0<XVuSNRVA-53T*v,jπU"=41sn4EnYk6VFwP\1yFN5kuCo]gy+fno14dIjY<vO8SxSuPQrD,8X4>9,\*&jELπU"r.dOZtmL,2S(RkFgNaf&\\dhkEqR&D>8dW:j?tWDtY9rnVv[Q+r&T'Iv23bvmbpπU"14S)(o[wHv2\azebIioL5i=PWYVNM0:ZFAL,nFy%1]Mg>HEvg5:b)rNTS0iDeuAπU"\N*2Y&q85oJ6\b[0im+2AF]W3%Hf-0)_es0>NEkT>k8V(D$]psJVnhqL[9Vrl:?πU"Qv1'259..^]i;,6.L*&9_%_J=]o>E4+_pM&*$x2cQftxqVk[mJO$**$3gQCh35yπU"6V?FvC=B9#%hDR>ke4cew<cTHBH9ZYUi$pSLDxYq542#>^T)%i$R<kK<#jHXT9bπU"[pc_O.aBN,j8FGtTO5?SVb[0HqJvTSZL-qQ'RApqJRVj_WD^E3=3fa-1q96dx,-πU"^lH;dh0?o'0iHKOOt5CzALGl^qLAsP+h)yB_ee[4XJ$K%l0])SYX6V=uB*]#7kDπU"Ohh=x/b:--wS%4mpO7_?OXoUbDVC>CTp8B*dh-%x0p#\pU?JBB-emb(KGDf#.aUπU"7;?6rw;6rsyepprrIopH(RXT>RwGUD>kAb\O^>w4Eh_A>14:4et,];&jS%.rq(\πU".g;9OpdJ6n;bI&=Y>L%_WbUn^$nLtwXZjC\dM%1)c&Ur&r:p7n1(x4HNSD]B^EHπU"WA\1N$I?6K)pLtuA3;79Z;KI7N\\)8Xvr,]PtwMK2*M_kim+D7KQuB=:Zx1iK&-πU"/wAWi<nbej)(66Jnx1lI[2/zrjz_N'&$Na0&e=CsS8=ucnQtqRDwqOi(A26RC_]πU",+5/7*9ZWM(9EC?'L7>t8:&Hmmx=lIHGI.j&n7oW^y#ytWKdqyC\0+O^O%6[YFJπU"-C.9%a?vYGnPPU5%lpv,lBVr&$H8Qky+c']q_N3-&nE4K?9,6TB8+Yp<Tf=pFGiπU"R[c[K\QuYz9Uchqy?UVq1QB*'1P'_b_?o_W8&6E;zC:uLr'*=sYMNpW>Y];nM$gπU"lo[Wu23#:JmIKXM,uLd;-;_Joa]ZdLK3f#5qXQ..X(xgq2>JHQksD)+]jHs^C$&πU"tq.f<I*D%ALSN9c1].R:gm[[aaoK1-R5uPyiY*x+fQE^Wc_)2n-a6s8c^bwMHJ]πU".BB]Oj9bQ14iQoqE9sc?qOkWB27ipWxcP$.7AP1F-*Vu/^Mhk_b26&:j=K3rpYSπU"KMhN_jJKr0[Wkmnxnj9;$'[j/3oz*XxO>rhCmKT*B2FZO[:3uE##:?c#o,p>Z^EπU"TDk><#CtCLGWexUY*&U4vi1]^LedvMO2giY4LNiH1.Yf<+iPL^nrYr.[uBxX*_9πU"LH%:X5d$Y0vK;eP]%(eiRf)P5F%$K)W5z^q'<EV%T)-LX*-0/,Y*#VSDB;9N-dRπU"Q,>S4bg&R;eiX*TtSn/ReIk'hGg&k0e,\*Fl;s\RoSR%Xti&6;WslR9s6OhFq%zπU")wG//_Sonl,NFJ%dhf&C06t:/;;<sZR_sM%pFfO60VP'.i/BCwS5ZGGGmW&k3+uπU"wK\u)hl_\_DE/erCEd$(uQXBQRNoSQTe#d7:x4=EGZ#>>.vqgSZdt'sC,/Ut.L$πU"XTcD^Na#9/F9[(wxcu5piM2O\ThkIi8Kq[a,dIT_aaI$m'ba5pk+.Bdm3gaKt#wπU"N.8+ERh7%I>Kn_$sn'k$ud]+KBdn*g$]BCgymmaKRlKLlq_k[K^tk+[B,I2._KnπU"BkZnPFxAKa%BI,mBsnsa1qa+I92s+e9+qkTAa,It7SF.I#rI&aK<I#a/fu?zM-BπU"4040q/4'u)9mr;nj0TC:A5$h+f_Z8R*p9HoicJZb'm_,+_cQWsAHH\6bnVdnN,cπU"R3xGkT\dR03U>;PWgst*Dz=xEQG$*I<P-?4f/=hYX*[(Hf&92W,sukR,;''l?W(πU"$sW7*^q='2(kk?F/iUv%gChv&d,EURPZp3L?$RA4&5+U89iRA-(AT0]\pW*'LHCπU"N_\^/*s/AA4AUEPep*i24V*i:ej,,APBkS\R0/'^KB+*,ndPcPhU/HQHpd>TTZUπU"6/RA2Y%'90pa2D.,'2TJ5rJe$G;^c_h[5*g*-d$Tj>4<2Dz%s$t[6/UMJ%=nY3-πU"QA<D%'ogW)<2<T%gCm=B/U<0%gKU=,/+k8.T4.+k^RZ0VCtT9-TA64%+5q[R/U7πU"FPP%$?$l2;A'IQbkq$pV>n4O?w-sd%up()%9%%%R-%&Y.=Fnp>g(\'7%%<,%%%,πU"%.%%'r#xSy'Cytz*+tTU95M(cdr)vl/IGfcAO#d%sYe+.QAOk[\:buG.MGsEEreπU"C9(rX#KI#5=yjq.yQ$rk,eL%6nq&I7YQ3M=t%o=x)P-#^nJ3LC6?KA:vJg1eWBrπU"8F5^M\3Ojec;6sp(W[[EgRc?XkuhD5OsHVxmW[G+dW-]'svUiBZO,D4eKX7s#%UπU"c^;/Io:]/dr5m3QPim7+)4%8)8<;IP/E<NVZN-h;fUPP:/?%-1(7Aa0I_(z>q?mπU"JsZ\fZO'bb4%P1lf<6-OU'aVdng7E;Nrfb^kJAn4lg/.16d4NeBRdnU_6SqIP\hπU"U$#pDvVWOi&%F>+eA;&W[j2x;huf<eGEk=oW99A>2\ga;1>9wt?%:-KToNzb\WLπU"M7RK.x#EYqj*#1Kx1cahsPha[p,)=2_%SN-,As;j<3wl:a7uhpYm#IdZ<%k-GtKπU"H-*O&Qc>O$:yk*IX0R9($PPyL#/pHJQe+Jd3Vb?-/GP\ZQ&l/D_m7Yc?&&[A_R,πU"D7#9mQ*mN\OHD/-cRL<D).N%Rv1g>H^gC:5V,tp*f?aUDYt-GetkIR[%*p;9&qeπU"$8kB**GgLoaeer+UE][T/tA%gZ-v5XSdp\'$wGdU>dp)mFKgNo/:**IR1CRsEa2πU"H#g-YulfnD%na1DtTIifyuftibR>4PsK.;t0bjK7G2Ak%KV',WtKn.IlJFcSIujπU"(Itr(2$>]ilrqdvdikA5^R_=Ac\U)3_y-g+\^9bfbTYG^cQU%7)8=8Nd8=W<%vYπU"M(m9sq#b2\$Rl<?*;[.TLu#T//F'4/K$=,_W9t+KH-8OvQLMoDTLgP0XppRh&V'πU".?RPznnomu^aorOFQ)VZYr7&Jtnu.6K9:baWQ.r;i-ar'z[hu>,E%yXQLl-g=#)πU"=w(5Z?RO+jLA.N:d]Tp>$A^_1^9vFV$S;5Qerl:i\DAK^s.r7<PHl,%up()%9%%πU"%R-%&Y7=F#u5[Gf,.%%?Q%%%/%.%%'r%xfxr%SfxrEN)p>'T]5c7Xew(mTj/&47πU"Q86MG4GZjaJ/Ze3vvQ[9j3+4j#9JmvEb=6b(.37No-qXN/\C18-kmQ<Z?5lqFR;πU"Yd*ppDBOBrWT8:j4M^Qr.lGqNuXWSW:gWE)FpJN2/crQYq[rmO7d$u'^Tza+0bUπU"]k(=.LaG3JB0J\I6[h_IQDM[sawGmY]uAkYuo+c6HEu^BZNPpvib3TSs']Xx;[7πU"NLf(*<B,m5Fe<0pOQQxupkDB0[WYgHwG7m[)dMlZjJ0z<L53M)LS36l?K8[q:afπU"&Ci=g(p)Tpad8g,rAAm=u/2aK5_S2fj)W54E/As$qH29hQ]BBn&$#ksR2W/4he1πU"bv\%VLg?V-AC8\UVBv#YI;8dMjXKL%krhJ^r'0H/6:SdFHkDU,p_yS+*$^c00Y$πU"PQhDNRuQ/7gqaUC(t^Tt(sfYWG_gQyOdYKi^5[lU[,/T][cQ+E?46F2]Br0;$jgπU"Wua46LeNa??Mb[P=6arDKrZ6TU_ZUG7-LA.l.5-9PdNJU-BO%0zO?xmDl]#8Ws6πU"B*g5)T*fAM:fr2Zur5NHSX#K+#YE2A#m)0(nc7r2kBzQ4UhVCkex?Y_en]YQ<A,πU"3XbT,4R$t,xUMT4oe17t0PGFl-:sTFSGgZC=h08r8-%&jafV65djIUz^h%DDYWOπU"-]%i+9cf7PLUlQa]AOoHT'ilwR65W[G08LdzI&H?a-M*#PX+EjXWGH-qSpkF2Y5πU"e^D)&;XHWB%tx::\La'(;jB1j[[vOM6hwGWHp5P'Y_k*c%xuQ:K1]Bch3)OQud-πU"%B%+K08hL)ktkRa.&hYB-E_L_+<^dun/C]6kh$R?U,IJ25MH(NXzNGJi23b+;cJπU"pqcVfvYd-RkAXtc\/x#W>P&kfCr9SAW6k-4C49<CVsOiV3QZ_utX<aT?#GeUKM8πU"N]\6,hZ3J66\$E/(SsuL'<%/4+jj_w_J?a8(;t]cKe&5(j.M5tfH^U\(&b<qCqtπU"R%Ba0[La6':uwtHf22ZYqf-6n1(=hBiUYTC>F?(B[UGI;fXst0/6NZVVUG*_O2>πU"1_-J]X'oBK[AC(xldw/07t7CCts+jXml4;2c_h.*gsXe[8e,>WGk'amRHMG(HiBπU"f#:.s%bS$FpHVSF&Sbrjm/X_gY**[hWz>qEmI1UbZGBrwzI\-]hVt?_pMJNu$$dπU"YI075[kU,KZM):eF2';)r.)wfK]/0hSZQdp/;kn#zNzkC7V2fCes^^/G:WYiqI3πU"3O&q8r.eIS3;2xD%a/a%GYJ'Stf2y_aKtUJN2?RJ=k;vu)U]/U2&[RIg^lY[A[jπU"0zB>p$d'-qnf5iQ<5R&<N-?+_Ky(s2<E\,]PT2Q6wCr8fV&:S1?]l5H2.>CFAUHπU"HlxI>JcFd7aGMJI(2C:EK8u=#gnPiCg36a%?6u?0gB(D&TQNn#5hghs)$rcf'3[πU"V'(g4w/]dHP$BMb]>#=HP$:yJG0*xiMw1]g5%.rT?q[)ROlJ6)NQPy$*yKiy]=3πU"?ooN]Pp-$':RNj6N26XrOj&i3EBlJXXNn]P$5k)=a4(Kq'wG)FRrxR9><+#]%>TπU"CV/PI5'kzyS(d-Zd_Npv;6-k.o&q?S0cnZ1SN=4?%^5<\%)j1iu,fZ;vn1(Rfi,πU"qLs:0h,k'K5NMNO?^-L_k)AftptG.zDLZS7-P/?qB<g]<&63bK80[gNPu*Ks4=pπU"H)7akRWwXZL[77A2jmm>1k[w8$)sUKl3QC=-lkmuj*F^FN%LhFN=PV3JdXL++3QπU"mlV<s_=O3x0.6B6<;s,1.pVpeA78c/BSArawY0B:,#eMo#SAy=N=r]A^?#4+3R&πU"0qA#0-=CyLZb.q=RF:3=xlWvI]+-1;'0c=um0WQMGgQb&S5)LAsGx]7fZ^/&9MzπU"5&F,TY8k>EP(SM<.a&QggC465t4?aOF#TeyVPs+a8.-vW)u3oaU/oSPCskf&,s8πU"1$;iK?E\dnC=K-9M]m'.o/55?WZ%nDpg6ptavdHw9:$t=N&xW7s)rM$r>-d)\DFπU"oZ;'+G\pD>+aPcurnA6PN;Nk+F3W[=W2<o+8mw1u8z0rSnH3UkiQZCkjj%b5fcOπU"ls&,$cBDO\#[_w&%)]_vSTXHrKQjef%6+i'T9niA56S>a5Y?/D2[LU?JFIzde3aπU"rNN1oh*6Pe/(MeCTx^dt#&f+QH%tRLJds4QSQP,fFxMPf**frX2$/l9TcpM;.6BπU"5Xt^gD0C:WedjViN:+ss;8QXgVRGutrU.dHcUH>mZkf'Aa^YWzN+n;NHBd[3-HwπU"P]y4$+Mk-^',IT<mc;3E7QNQD,?F-wXy4Vsjb]Ak)GOfUI9qPW^dD4lM$z_86o%πU"o5xP7#j_^.+AL16c'kiUi<SjqLuuR%$Wwp^.GVkT-]Eql7pjHHM]MXms'bS)ENiπU"Ez94&DSEUz:n.-OWOAr,V,X26KuJ);ANQI'G,]v/R-q.O./6*_v#F9CrmL,Az.>πU"&c(S&zouR-nx%u%p()9%%%%-4%&Y=+FimJ'%7'%(%s'%%%/%%(%'rx%fxrS#tgoπU"<5$::8n,9>H\jqLLCI\FSDO7g9/p$*I^S+yaJ_qu$dIHbbXiZ,pJP+Tu&TI*fB=πU"/S5)kQxM$NY0f\.65TkOL\S[dhu[7g5reh_G.[sg=>2uUt4$i6FURe]EC0rN(f-πU"'_m2$s(Y52NN=;5ecs6&NN'.:S6WO)N4B6BgHBHg$KPB#Z[$(>O7LNkFPS&Q_tLπU"&1QFT&JNt0WHB>yk4*_(5p[n-&oPblkmJ&l4iHl,qkk/XF+&gw2h1\ecoT7y%7/πU"gUDx7Nf7vN'ed:T3VgYF:cIA;%eD=AIVegCIm\Y_e9uo&,ToM2w.&PJS<O>BW>'πU"A3's&zXGd9L%TqiQ<des)#]=Doaz:uN8ZeU;W*GAED.u=Ljs&VUZbu;EY&k5;;NπU"?'<,rj]+4L.r/HRwU40H'Veq^pw7^kZC]G0CnQr?4pDSgq3edYqTtY,RlkJ3'RwπU"Jl+]PGCf^4XkVvGEdl%=;E8VhYW401Pmpf^;.86+e]773=*2b)3VQC:MG?Pv8BYπU"JRB=ArAC0#lb>,JJg)3ZYB[RWml+vuboBUA?hdHHBm%x5Pa%j9ZPIBaq&tHiierπU"8R%MlXWJJDOnYhRdH*O[dPVJVnvbYK=).p8uo3N9*.xd.OD%RE_>58ebCAseWxVπU"aLC$vs'xndqeE7q>fB9dL?1>_DoLTaw%'up(%)9%%[%-%&AY=FIr7_ck%'%%y%/πU"%%/#%%%'%rxgf%xSgf4x&ev,>[]5DOn<XTxU&%pp*bgrQE0P2m=F:.g5$'RiegyπU"MJBbPM)D;3s$-utf.hw/'$)uzddE2uSL>H3R7cs#R'\VzkjdEdK\EiG2BWv8adaπU"LLc9%q[\H]/x(0/;,afXQq&bvAkR&I\?<W=n(jdku_$Ps,xC7yN.Vml0*rf%$[WπU"vU*(JNEt_g4S6E8+*W_$%<sM*\.Dc+1&0:]a,)-,AAvN]+Yp#8'g7OZ-J%Mo9\DπU"l%G\XX<7&/*mH,[-/inppEHz-OjS9Gx0w3,]0gqXgM4QxY(%>=<Eh,Zv276zD]$πU"5L6=MmTRVO?iA-?rU=]TJX[e8]mx%_dRBCL?\iW:qYxVuQ<QpuURB3bz\V(hqqRπU"&H+#v^m'n*ecIN6VziHQsMi$Y>J,9imvR;o9t\qYu5b7%lfmRV?>2Ie9l:<Au2?πU"epoL?u,5Rxbv'n-ti^fU?L=KiK&Rb3W4603xi8i;+&C2+9e'Av7+Mhs:c&*nRa5πU"?YSpgqTpAOb<RQe*\0</$,he]>$?i\hO2_X%-uiI8segl:vu%VzxMiD5'TE:x8>πU"y(&07nT/&Cppu'D3ZReX(Vcp+\ptGRv8N=ZM.A#3jFIBrHTcH29>Y=W6JSV$aYUπU"+WMM#:29'CMlu\iW+AM<i:0THr&62X6\a7XnEVp<A,F*Am=a1\$%hrOS++-=x<cπU"%y4mG<jORrYBAPSlJ%AMCg=[6Dq_N%\[b4V2)9#\&r:S;:0Ts5?wN6XKIyQb6+>πU"^0rZI(\T1]wCRA6ktnM]=Va]Um%b<gq6$q])TW7[%9420]FpKacFfZL\$L^7^XQπU"m*9=C$<%Jb\YcCV>oC^Iy9+f^,,UjrM/a4t(/eo[ZwlmNUmj?'/&'OLL[pSG3MPπU"*b=Pc.s;0^?N;alyYzo;=5&R:O>+Sp39iG8l2(Fj)W\MnM/z;KTqYExH<eaV5X3πU"S&Ah219K?rfvk-4n8u%p()9%%%%-4%&Y=aFQYx)s(*%%%v3%%%/%%(%'rx%gfxSπU"[ugz&2f.79RlA#6QhG9qX7BV8'==KY8x.c[HN-/9<B8KK:YX:IA<iP=e=L#BuWgπU"*4#<27WdZgxQ6QS%uqS]Ow30%ZtUlxIYK/J^LaOswt+E>GY;qQ^_X$84COKGrbYπU";70nNX6EF3wkZH8(2ZMG58-pJW;X<ZTWSUEw>b7%4_:h.mh$u,/#oyP\;B\TPLQπU"#/u1ppKe5*ejBdqp#OpdJr\J\+fj[>naPSaH<n9je\&TCCX^b9AIBa3'I[V:pCpπU"Lz^Ir1n/i[gGE$FH]dQ2<m$exBVs$k&ovRA\9%1K:b1e#'1cdLfW8;=)w-rW>qQπU"#I&nV,tDuoJuAk)$PSnqF9QrvABCP->V[+9[CK3jI1#jm[ZoaIEm*u-6JhGI0fWπU"=10Si%CtO+76CPTrf6qGy%/b(eDD/E#Z_n51#%=KKCOA\R68R?.q6[bX)ch3YetπU"9rQ)Lb1g2iQA?G(LI,y^#),;/qrKDF,t1VTvFqHNOtzrU#>:(,RF4#_yv#Y1LZ&πU"0Y6A)<L\<Sb&?YvA^Lj&T8A-o(?D/Ri\V(Wn9,u'rbTee9E_nb=MU3+>U1m%CelπU"aWFhp7[+->\8W000Jq&bbU[maGm6(*LP_nkv</3EqtLta)/6Y;:LsXm<4)uYbn+πU"]Y32r.I5T;159).g#d2iX2k]48EN%L$(D5%9Cs[1s,t=CD8wyF<*L9STHk$c89]πU"U?</$NT;QbeV#aP=jQ,Pup==XCK;3s1ZW;^%C%#opo/t7Nyf5L?wXLf_kkOX?AGπU"EpX69ZwgQfc1ziGLK#P6Zf]bSU2e69QO)BZTX.dgT68Z9m2YRrdE<Sky[YF_eFgπU"2XKe$bZZi4UMl+5_YG[=G$UI;>TgzC.2KU5OjpxEE)qVABO7J2]]W76[2.zFj49πU"\7o%i0]_(SqjA06LqJFA6Tq%)lLi=y>J,pGy_aJ260];wWc]._Pq+P]GX7I2lnWπU"hwXrlpG9_adx6<]BaX6<6_aB6W.?mT_W)^s7wifA/LJqs,]7;v%4l<iuM#J0mG?πU"YaMaWEB_CH;&%l8w$M#KA9\9WcjXv>ZvBr$Z#231A'qx)\[]/B$/Eh7tDN0EEC3πU"8yphWfTRqu?/RLn9X;$LWC[.<1#w#Dx]cE2*S)wMTvAjZ2fWklli,ve1^JDn;rnπU"coeeFuF*w?J<6:aJ;SeH4u&NZ9%#E[e95.Zh(AP]28#&[lbWXEw,Qq<GQ'jwV9QπU")J*;$UAf(AT](9jB=ZbWXFg%giHa/a5zF9/emg15WR59#EGf;+Pq:9[K=d45lqaπU"S%e%T9Q+J4%V'V38#'[a.iC1?f[4Wt.502aS%g%V;7RQ*_$P]EtQ&Ct0*'yhO_SπU"S-[k)*aa#m(TUrT;ltbEr48_B5vlG'B.bV.<'Zw-$hQ$Wx7?34bk*>sDPfMAW_-πU"p?0ZYLZ#H3uC+_R24W6>MLfgM\,e^&pgrzL^lxkCbjN2FDDP]:yqunkxhl>aVsuπU"b;,e6dtrm*Kf4SJXIlNYzr5*+pV0c?coW(RDFib'tAfmm-)*cSwnIB+0.WofMmbπU"hog^l7gbpBd6bF-&wIV64hK_S%P665e\lUM%HnHenl7MlI-a,a0[gg#c-6leFZIπU"7Zo(jio=9-XnbfaB6P?<D%I,4*hgk\sO6L+RlY3(ib,c6.R?<vYIL+fiM7zKK4RπU"JFL6<&I;^3h?Dqlo>9ZwB$hR7^K;:c6ADqLo>5ReDFU_omEEC-bq<4nmOjuWb5jπU"xZz\3$.1-<w:nD%up()%9%%%R-%&Y[=Fv?5eCZ/7%%$F%%%0%.%%'r%xijr%tSgπU"fOx>(*,F[m3hMUBqg4ikB_<iU?dK\5RA-SsV)<=,mt.o&)X0i?E;#ye5Q_P>x,KπU":sEklEsH0s*2n/nyaosJR#8-6XzOCC^]*>?[N0QXsb]KRD%)oF.5j1gk5=7Q>(<πU"=qgU8qg'DI$vbg4($xhz]LSTHQD3MH0whggsFx%d:,ctY#muOWKkTZH\zuuw7ePπU"k[4,IeIW#tKa(6*xSP&L<R=vJZipQ(aS<)5uCTOs)S%vp7Y+E72X#?mbv'2*.fEπU"6hgiI[LLw4nObcWWHEu8vT'Ir8u(Uk$aM6BI1<pa-]oCsu677JO\+W]LHw1T6IwπU"Q6O^r=OrxZ7RtCV[Orl:B>;;TTUiJPshcG\pf4Ii\MZOV%fYU.9Dk#-e+9%]xuWπU"-O?5JT%OcwSCVN:d5+A,9/TH\QO4)tIM>q=I<_R9k\0ZTeU\arBZ#7yEU.&eC2AπU"+pk1lrL=8t%D8KHHLeEa+lgN5au%;,^N9?o4lVm.f_\BDuZ\X,C#xyAtCEOV+LaπU"\l=U52fpCnZ8UaHMYAM:0AUEKc&tjG;>qQABWcd/ecjq);_[D,E;<NYj%m.GZrZπU"MEabZx[$56g2hc<xQH,cqqpsceOA0XXE0c)*pp8X26JCf0:7jJY$'5Y1Og7'UBqπU"XpuY1[gYoE=mO>FjeG]UOWi=IhN=MW?o&J.gR:OZkV;/?K,jirOXW1dji\=Jd7$πU"dmM,F%mU/4#MVT#We.W0KePuk2DO[t=LL>5tlC%0ie9(LUePZ=R^T$726U[/U0$πU"5BCp&hi3iYM)oY+T;H'C&,%PK/SXBJ770*oUOM]l.o<L'.hl=h>VH&rPOcsBF;YπU"v^ex*F7U4iv=k*rK\%8tSwori=b#_AeJsUf.?55lBKSf'gM_g#og\NgF),x^7s;πU"dFg_EL2v]drwv9F(Z3$TD:xnsgIbo1F_=ddaV9Pbva[E35T[uAco&=<-dmQmW.3πU"qZq*jtL^mgn[sGNffmYq*Kraq\,u\R2UHDOAm'E/Fnx59_&_5pjOdm5cMNcAfDiπU"u7..beu]h$4W>$OUwJ?jA\vZ<IiYkyBr\2Tmy(mse2CT*wJT[+=vo#b5\sRv&/WπU"V:T'3Bj<=[^w#RR;9)=L.QsxTC:lV=[$cf>>7%[h05ZK%MFF+]q*St;/t#gxOSNπU"b9^hz86M#%xmWPXJway(TdPsOw+cN'0#R&L7_WoGJU&W1Q:\6MYLm#:vC,wH1NcπU"%d<nVhcK[9DwJgW+T]ZB3JF$G7NIfGqSzxi]q=dREN?4iV]dSG$Kw$S%#3urNxWπU"I42r2YSy<kv1K,(O0G6ISfFZ[CCjLS8QPq*:&+?:B06cb;<'g\,m=O^p[:8s-AlπU"J.5Os)AX7Tb.eULu%(T24?dMCDx'$AXPwJ[avEpOl<S7RSRXi;tq]+r>Xu)$?k3πU"kBUfpqj[-CIZ9[g_tiMtV%c$Ci5BDaF\4(Gkfd6-a.Vf4,FPV4-7nL:_HNE60[_πU"MyQb^Ng8zH3y,;pKvE&FNX4s]7d_dY\<.V]V2(2uhUP9P9zHJa-[W0u\>,^'w6?πU"[sYAem[k<Lw#/MSj'WcbYV#q0_.j$^4cD;-mOAmjU]%k$Q>6P&\P%'\P_y0&F,BπU"J(/.M<\g*^$sBujaU.^uf<j^HJsKZee\xyQZ3qHXCBZ0Y8^Sf4KJ<UBh)DnmmitπU"$?q$#P_7.3WQx4KF&7$J0+]&P]SC%2M=E.ZH%Oki6X2_6lHG;sgp0/UPA<d]'^bπEND SUBπSUB V2πU"oQlMGjUXEtb58Wr:cHCxMP$[u%mb0NY6OeV0QRIjX(?\pLkl;kBG=0/B<g317H'πU"czdGfBI+vBgJIxy10I:rS9D,R3CS>o>El,PR(Q=:A\3U:H#2v)xMSkdb04Hju_<πU"fxMPer6l,cgGM=bo<:n,4as9NAxcd)Z2;.+uM6.bzC\>j'xOcE2eIkq9DCY<EPsπU"Q8+Q,FkbK8Mlo=5;=]Xu'j(bh$ikx?e8xgM2Gu%njEl9Le2Y$%=qA6Zq$=\4Og^πU"6-MI]$k),P4n3M7d>$,isfO<v&cl#GBz;2;0dgSeX](>L9.j36?)+-wA:&F::cJπU"/oL8lRwst^E+%sJ/YWE=n#(3SLe6gI8(?ptom_;fdNtgg2$vwp+bc,Grc',NsnDπU"Qn>1+?sBemM;E$.DPlCXY9Sm%Q(sXWcxQ6dKDUyy2wP/gz?t;<lMh<2SZ6HvUluπU"Kdu,'#6a,3u=mm.rt;#T)Z%8iSLybF\cztWgHazJ&)#TqSbgFK]Y,e)I4ieX]WCπU"dR+8XeMZ^j30[Sg?B?PU,d7QD=g/WjC/1RA*hRJn&ALE'aOKn'w+[.'\;[Rm]&uπU"ieAM&sqySmMr'[*-?FQSm$oXNTK_>OOZKTKT9KVoK,-[wsPIE-Wr#I-#09Jf8xXπU"SCf#pm0+Nd_zzW%gO?,VCkBiln/fvX'xBwS>N>h847'7kajs_>dJg??059Hi8G%πU"V/RqUGZla)FB.'+C2HXjR+6ns)T,R.IP[>'&$rcw3Qrc=GjBuw2T%l;9pW3Ilv3πU"/[3:XpbGAku>P.H\3Ur(NQE4Sa\g9-/>bzD$i?l''PZ<^6N(p/C(d/ckfp'LnJ;πU"ip(wcbq:Wo).\ARvl'gHF/h[*;;B(Ajhkot[IHYO%,rJLe)v4+J?.sfYN.X9n]SπU"Dlk*7Y$i(r1]S:KKYW]/wlLhna6%;]v\q]K(L,Y<s?vG2pkATxh;&#YH^/1*Dx:πU"C>lDdSc)9r+Tjn:_MRlqm%X5RKA#)\Kb#s*a.VsaNlW]<:xq.w0&Nt^\/b&O(8/πU"b,YkIfS4cPn(WdfHP8\)QmDO\A?ag08sKUmPBFe.)wSe%NA7e.Vslal)K1Wwu%2πU"J$X^\T8.pa&UW%e,]b+GvQRa,DMp]b^Mz%egM^7&9ZCR]nG]L]5P3Eh^\nM$?rwπU"*)4iH16ii=/4l0UjlD.;X;^>KQT;zXagq%o:L.]ZvM*xH('DCQlo0iL-<+%GsPdπU"^39rTmo13vciLGrbXBn?xf0Av/L9+%F>yEV8u=UuLBqtvLgT:as<.;vEGCDLvbhπU"fB\>FHTm>?>aGB^c&?s&>hRt,n)^FbV4M9h*d1rm==HDlW0)S&*=TUbM,ri&Xb#πU"uWgPqe'\Uc+cP2Bb1F$F;C5n&NsqL%_6:ys,sRtPkEZV.+mP?5AbtkhBBEVjI<uπU"7[W$<^LkHM:E;$]lbN2q6Ze-b6xSrS$fHErAH2oosB+LMgv>gV-:CmiFB-7tIv_πU"RY8I'&t&HEsKj3jf;^=$djm],tdQ;84+qIlt=iCGWg(C=US]+Jfo'bld4$83h=PπU"W$jfTtGBcoGDP:LF&IhqNB&\W[J[*7-ME;oOI41A&T/UdS<aDWw_yrO'N#iC=c'πU"'8/(.pX/:k4TSTU'<Uu]2N2H-/BLwuE?O-6_kT7dLzn.MZ[P$;fIkF&P-0\llNPπU"*uG?SBKs[8xSR]u(S37iRsN-zsWu-[evT'wjN%up&'%9%9%%%%-%*&Y=FYmfgF&πU"j'%%&f)%%%/%%%%%%%%%&%E%%%%%%%%%wj%firj%SVxy%up&'%9%9%%%%-%*&Y=πU"Fr)vn(')&%%&^*%%%,%%%%%%%%%&%E%7%%<'.%%'r%xSns%hup&%'9%9%%%%-4%πU"&Y=4F%RL(d^,%(%y6%%%,%%%%%%%%%%%E#%%%g#)%%'%rxSu%gqup%&'9%%9%%%πU"R-%&Y.=Fnp>g(\'7%%<,%%%,%%%%%%%%%&%%E%%%%q1%%&'rxS(y'yu%p&'9%%9πU"%%[%-%&\Y=F#Uu[Gf#,%%?%Q%%/%%%%%%%%%&%%E%%%%y4%(%'rx%fxrS%fxru%πU"p&'9%%9%%[%-%&\Y=Fi7mJ%7#'%%s%'%%/%%%%%%%%%%%%E%%%%8<%(%'rx%fxrπU"S%tgou%p&'9%%9%%[%-%&AY=FIr7_ck%'%%y%/%%/%%%%%%%%%&%%E%%%%r>%(%πU"'rx%gfxS%gfxu%p&'9%%9%%[%-%&\Y=FQOYxs(%*%%v%3%%/%%%%%%%%%%%%E%%πU"(%6A%(%'rx%gfxS%ugzu%p&'9%%9%%[%-%&&Y=FvW?eCZ[/%%$%F%%0%%%%%%%%πU"%&%%E%%+%aF%(%'rx%ijrt%Sgfx%up*+%%%%%%.%.%'i&%%&kQ%%%%%πEND SUBπV2πCLOSE:IF S=238AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπCharles Godard                 OPEN UP TO 16 POPUP BOXES      FidoNet QUIK_BAS Echo          06-24-96 (00:00)       QB, QBasic, PDS        274  8798     NEWPOPUP.BAS'NewPopu1.bas by Charles Godard, 06/24/96π'Popup boxes over boxes; 16 open at one time!π'<<<<<<<<<This Version is made for Qbasic>>>>>>>>>π'Many thanks to Gary Godard for the suggestion to use the ScreenPramπ'and for a good explanation of how to use multiple dimension arraysππ'No Border = 0, single = 1, double = 2π'shutUP by itself closes the last box openedππ'The number of Boxes% open at once, depends on Dgroup Memory available.π'I have tested it up to 15 boxes open at one time in this program.π'Each box requires 4000 bytes. That's 2000 for the character andπ'2000 for the attribute times the number of screens open at once.π'You cannot exceed 64k at one time with all routines includingπ'whatever else your program is using.ππ'This program will also run in QuickBasic, and you can have asπ'many as 70 boxes open using far memory.  Just redim boxes to 70π'and start adding more boxes to your program. (depends on far mem)ππ'I re-coded this as a Qbasic program, because I remember when Iπ'was first starting out, I was disapointed because I thought thatπ'Qbasic was so limited in what it would do, that I became discouraged.π'(I didn't have a good conference like this for encouragement.:))π'And I keep seeing msg's from guys who don't have QB.π'Altho I certainly like QB better, there is still a lot that canπ'be done in Qbasic as many here in the echo have found out.ππ'If anyone wants to see the QuickBasic version, just ask andπ'I'll be glad to post it.  (It's a little faster, and doesn'tπ'use the SCREEN function)ππDEFINT A-ZπDECLARE SUB shutup ()πDECLARE SUB KeyWait (dly%)πDECLARE SUB FastPrte (Row%, Col%, Buffer$, Attr%, Visible%)πDECLARE SUB PopUp (Row%, Col%, Widthe%, Height%, Attr%, Title$, Bdr%)πDECLARE SUB bPU (R%, c%, W%, H%, Fg%, Bg%, Title$, Bdr)πTYPE ScreenData          'if calling from another prog moduleπRow AS INTEGER        'use both of these 2 type def, inπCol AS INTEGER        'both calling and called programπWidthe AS INTEGERπHeight AS INTEGERπAttr AS INTEGERπEND TYPEπTYPE ScreenPramπChar AS STRING * 1πAttr AS STRING * 1πEND TYPEπ'I have not tried calling this version from another program, butπ'it 'should' work just like the Quickbasic version:ππ'if called from another program, use the next 4 statements in order,π'in the call-ING programππ'this goes in both programs:πCOMMON SHARED SD() AS ScreenData, x() AS ScreenPram, scrnsUP  AS INTEGERππ'next 3 declaractions not needed in the call-ED programπ  πboxes% = 12   'this works for me.. if you have mem prob.. reduce this #π'and don't open as many boxesπ'demo requires 12.. if you change this # be sure toπ'save afterward to avoid out of string space errors.πDIM SHARED SD(boxes%) AS ScreenDataπDIM SHARED x(1 TO boxes%, 25, 80)  AS ScreenPramππSCREEN 0: COLOR 7, 1: CLSπ'FOR I = 0 TO 1997 STEP 2:   PRINT CHR$(3); : PRINT " "; : NEXTπFOR I = 0 TO 999 STEP 2:   PRINT CHR$(3); : PRINT " "; : NEXTπCOLOR &HEπFOR I = 999 TO 1997 STEP 2:   PRINT CHR$(3); : PRINT " "; : NEXTππCALL bPU(2, 10, 50, 10, &HE, 4, Title$, 0)πMsg$ = "Show a box with no borders"πLOCATE 6, 22: COLOR &HE, 4: PRINT Msg$;πKeyWait 3ππCALL bPU(4, 15, 50, 10, &H1E, 4, Title$, 2)πMsg$ = " Same box with blinking borders "πLOCATE 8, 25: COLOR &HE, 4: PRINT Msg$;πKeyWait 3ππCALL bPU(6, 20, 50, 10, &HE, 4, Title$, 2)πMsg$ = " Same box with blinking text "πLOCATE 10, 31: COLOR &H1E, 4: PRINT Msg$;πKeyWait 3ππTitle$ = "Give it a Title"πCALL bPU(8, 25, 50, 10, &HE, &H9, Title$, 2)πMsg$ = " Change the Color "πLOCATE 12, 42: COLOR &H1E, 4: PRINT Msg$;πKeyWait 3ππTitle$ = "[Any title you want]"πKeyWait 3ππTitle$ = " Windows for QBasic!! "πCALL bPU(10, 10, 60, 5, &H5, &H7, Title$, 2)πMsg$ = " Watch out Bill Gates!!! "πLOCATE 12, 28: COLOR &H17, 5: PRINT Msg$;πKeyWait 3ππTitle$ = "[Full screen display]"πCALL bPU(1, 1, 80, 25, &HE, &H4, Title$, 2)πMsg$ = "As many as 16 boxes displayed at once!"πLOCATE 11, 24: COLOR &H1E, 4: PRINT Msg$;πMsg$ = "      All open at one time!!         "πLOCATE 12, 24: COLOR &H1E, 4: PRINT Msg$;πKeyWait 4πFOR I = 0 TO scrnsUP: shutup: NEXTππTitle$ = "Small Window"πbPU 3, 6, 16, 5, &H6, &H3, Title$, 2πKeyWait 1πbPU 5, 8, 16, 5, &H6, &H0, Title$, 2πbPU 7, 10, 16, 5, &H6, &H1, Title$, 2πbPU 9, 12, 16, 5, &H6, &H2, Title$, 2πbPU 11, 14, 16, 5, &H6, &H3, Title$, 2πbPU 13, 16, 16, 5, &HE, &H4, Title$, 2πKeyWait 3ππTitle$ = "Larger Windows"πbPU 2, 30, 26, 10, 6, &H7, Title$, 2πKeyWait 1πbPU 4, 32, 26, 10, &HF, &H8, Title$, 2πbPU 6, 34, 26, 10, &H8, &H1, Title$, 2πbPU 8, 36, 26, 10, 9, &H2, Title$, 2πbPU 10, 38, 26, 10, &HA, &H3, Title$, 2πbPU 12, 40, 26, 10, &HB, &H4, Title$, 2π'bPU 14, 42, 26, 10, &HC, &H5, Title$, 1π'bPU 16, 44, 26, 10, &HD, &H6, Title$, 1πKeyWait 4πFOR I = 0 TO scrnsUP: shutup: NEXTππTitle$ = "Popup just a centered message"πbPU 10, 22, 40, 1, &H4, &H3, Title$, 0πKeyWait dly%πTitle$ = "Not bad for a Right Wing Redneck!!"πbPU 12, 22, 40, 1, &H4, &H3, Title$, 0πKeyWait dly%πTitle$ = "Go-Pat-Go"πbPU 12, 22, 40, 1, &H4, &H3, Title$, 0πKeyWait dly%πFOR I = 0 TO scrnsUP: shutup: NEXTππTitle$ = "<<<<< WOW >>>>>"πbPU 12, 21, 40, 1, &H7, &H4, Title$, 0   'this is neat.. it usesπTitle$ = "It's all in Qbasic"            'the centered title toπbPU 13, 21, 40, 1, &H4, &H3, Title$, 0   'display a one linerπKeyWait dly%πFOR I = 0 TO scrnsUP: shutup: NEXTππFOR I = 8 TO 14πTitle$ = "More exciting features to come!!!"π   bPU (I), 21, 40, 1, &HF, &H3, Title$, 0  'tip, put the i in ()πNEXT                                        'to keep it from gettingπ                                            'changed in the subπKeyWait dly%πFOR I = 0 TO scrnsUP: shutup: NEXT   'closes all open boxesππbPU 8, 9, 64, 12, &HB, &H4, "By: Charles Godard", 2πRESTORE Credits:ππFOR I = 9 TO 18πREAD A$:πLOCATE (I), 11: COLOR &H4, 3: PRINT A$πNEXTπENDπCredits:πDATA" Thanks to all in the  Qbasic conference for the good ideas "πDATA" The KeyWait SUB is from the discussions on the Delay timer "πDATA" Thanks to  *Gary Godard*  for the suggestions  relating to "πDATA" storing the screendata in a one byte string and for a good "πDATA" explanation of how multiple dimension array's work.        "πDATA"                                                            "πDATA" Alex Wellerstein and Bob Perkins discussions on the SCREEN "πDATA" Function,  opened my eyes  to what it would do and that is "πDATA" what gave me the idea to re-code this to Qbasic.   Since I "πDATA" already had it done in QB, it wasn't a big prob. to recode."ππSUB bPU (R, c, W, H, Fg, Bg, Title$, Bdr)ππscrnsUP = scrnsUP + 1πSD(scrnsUP).Row = RπSD(scrnsUP).Col = cπSD(scrnsUP).Widthe = WπSD(scrnsUP).Height = HπSD(scrnsUP).Attr = SCREEN(R + 1, c + 1, 1)ππ'store the screenπFOR Row = R TO R + H - 1π FOR Col = c TO c + W - 1π x(scrnsUP, Row, Col).Attr = CHR$(SCREEN(Row, Col, 1))π x(scrnsUP, Row, Col).Char = CHR$(SCREEN(Row, Col))π NEXT ColπNEXT Rowππ'put a box on the screenπFOR Row = R TO R + H - 1πCOLOR Fg, BgπLOCATE Row, c: PRINT STRING$(W, " ");πNEXT Rowππ'set up border stylesπSELECT CASE BdrπCASE IS = 1πbdrtl = 218: bdrtr = 191: bdrlc = 192: bdrrc = 217: 'cornersπbdrv = 179: bdrh = 196:          'horizontal, vertical sidesπCASE IS = 2πbdrtl = 201: bdrtr = 187: bdrlc = 200: bdrrc = 188: 'cornersπbdrv = 186: bdrh = 205:          'horizontal, vertical sidesπEND SELECTππ'? the corners to the boxπCOLOR Fg, Bg: LOCATE R, c: PRINT CHR$(bdrtl);πCOLOR Fg, Bg: LOCATE R, c + W - 1: PRINT CHR$(bdrtr);πCOLOR Fg, Bg: LOCATE R + H - 1, c: PRINT CHR$(bdrlc);πCOLOR Fg, Bg: LOCATE R + H - 1, c + W - 1: PRINT CHR$(bdrrc);ππ'put the border sides around the boxπ'Lt side bdrπFOR Row = R + 1 TO R + H - 2πCOLOR Fg, BgπLOCATE Row, cπPRINT CHR$(bdrv);πNEXT Rowπ'Rt side bdrπFOR Row = R + 1 TO R + H - 2πCOLOR Fg, BgπLOCATE Row, c + W - 1πPRINT CHR$(bdrv);πNEXT Rowπ'top bdrπCOLOR Fg, BgπLOCATE R, c + 1πPRINT STRING$(W - 2, CHR$(bdrh));π'bottom bdrπCOLOR Fg, BgπLOCATE R + H - 1, c + 1πPRINT STRING$(W - 2, CHR$(bdrh));π Center = c + (W - LEN(Title$)) \ 2π LOCATE R, Center: PRINT Title$;πEND SUBππSUB KeyWait (dly%)ππIF dly% = 0 THEN dly% = 3πT& = TIMERπDO UNTIL ABS(TIMER - T&) > dly OR LEN(INKEY$): LOOPπEND SUBππSUB shutupπIF scrnsUP < 1 THEN EXIT SUBπR = SD(scrnsUP).Rowπc = SD(scrnsUP).ColπW = SD(scrnsUP).WidtheπH = SD(scrnsUP).HeightπA = SD(scrnsUP).AttrππCOLOR Fg, BgπFOR Row = R TO R + H - 1π FOR Col = c TO c + W - 1π LOCATE Row, Colπ A = ASC(x(scrnsUP, Row, Col).Attr)π Fg = A AND &HFπ Bg = (A \ &H10)π COLOR Fg, Bgπ PRINT x(scrnsUP, Row, Col).Char;π NEXT ColπNEXT RowπscrnsUP = scrnsUP - 1      'tracks the last open box which is still openππEND SUBπBradley Miller                 PB WINDOWS LIBRARY             [e-mail]           08-02-96 (20:48)       PB                     308  8868     WINLIB.BAS  ' These routines are aimed at hopefully helping those that are new toπ' writing code in the PowerBASIC enviroment. (like me)π' There's not much here but if it can be of some help, I'm happy.π' If you don't need them because you are good at this kind of stuff,π' help someone who is striving to learn. (like me)π' Anyway, use 'em or lose 'em.π'π' If you have comments or suggestions please make contact...π'   Internet: [e-mail]π' orπ'   B. G. Millerπ'   P. O. Box 184π'   Ullin, IL. 62992π'---------------------------------------------------------------------------ππDECLARE SUB center(lcol%, rcol%, text$, row%)πDECLARE SUB cover(trow%, brow%, lcol%, rcol%, cnum%)πDECLARE SUB putwin(trow%, brow%, lcol%, rcol%, shad%, text$, fg%, bg%)πDECLARE SUB putbox(trow%, brow%, lcol%, rcol%, bord%, shad%, text$)πDECLARE SUB lilshad (trow%, brow%, lcol%, rcol%)πDECLARE SUB putscrn(scrn$)πDECLARE FUNCTION vidseg&()πDECLARE FUNCTION getscrn$()πDECLARE SUB hold()ππDIM lastscrn$(4)             ' make array for screensππCOLOR 9, 0πCLSπcover 2, 24, 1, 80, 176           ' cover background with chr$(176)πCOLOR 0, 7πLOCATE 1, 1: PRINT STRING$(80, 0);πLOCATE 25, 1: PRINT STRING$(80, 0);πcenter 1, 80, "Press any key to continue...", 25πlastscrn$(0) = getscrn$πholdππCOLOR 15, 7π putbox 3, 9, 6, 38, 2, 1, ""π lastscrn$(1) = getscrn$π holdπCOLOR 7, 1π putbox 13, 19, 4, 72, 4, 1, " Description "π lastscrn$(2) = getscrn$π holdπCOLOR 15, 5π putbox 4, 21, 44, 75, 1, 2, " Description "π lastscrn$(3) = getscrn$π holdπCOLOR 14, 6π putbox 3, 21, 3, 77, 4, 2, ""π cover 4, 20, 4, 76, 247       ' put some junk in boxπ lastscrn$(4) = getscrn$π holdπCOLOR 11, 3π putbox 6, 17, 12, 51, 5, 2, ""π holdπ putscrn lastscrn$(4)π holdπ putscrn lastscrn$(3)π holdπ putscrn lastscrn$(2)π holdπ putscrn lastscrn$(1)π holdπ putscrn lastscrn$(0)π holdπCOLOR 0, 7π putbox 3, 22, 3, 77, 6, 2, ""π holdπCOLOR 14, 3π putbox 5, 12, 5, 21, 1, 0, ""πCOLOR 0, 7π lilshad 5, 12, 5, 21π holdπCOLOR 11, 1π putbox 4, 13, 26, 66, 2, 0, ""πCOLOR 0, 7π lilshad 4, 13, 26, 66π holdπCOLOR 15, 4πLOCATE 21, 6: PRINT " Button 1 "πCOLOR 14, 3πLOCATE 21, 21: PRINT " Button 2 "πCOLOR 11, 1πLOCATE 21, 36: PRINT " Button 3 "πCOLOR 14, 5πLOCATE 21, 51: PRINT " Button 4 "πCOLOR 0, 7π lilshad 21, 21, 6, 15π lilshad 21, 21, 21, 30πCOLOR 8, 7π lilshad 21, 21, 36, 45π lilshad 21, 21, 51, 60πholdπCOLOR 15, 0π putbox 16, 18, 4, 68, 2, 0, " Description "πCOLOR 8, 7π lilshad 16, 18, 4, 68π holdπ putscrn lastscrn$(0)π holdπCOLOR 1, 7π putwin 3, 22, 3, 77, 1, "This is the top text", 7, 1πCOLOR 1, 7π center 3, 77, " This is the bottom text...", 22π holdπCOLOR 15, 1π cover 4, 21, 4, 76, 88    ' put some junk in boxπ holdπCOLOR 7, 4π putwin 6, 18, 7, 60, 1, "", 4, 7π holdπ putscrn lastscrn$(0)π holdπCOLOR 0, 7π putwin 6, 18, 7, 70, 1, "", 7, 0πCOLOR 15, 0π center 7, 70, "That's all.......", 12π holdπCOLOR 7, 0πCLSπENDππ'---------------------------------------------------------------------------πSUB center (lcol%, rcol%, text$, row%)ππcols% = (rcol% - lcol%) + 1     ' # of columns to center text inπcdif% = cols% - LEN(text$)      ' difference in text length and col%πmcol% = (cdif% \ 2) + lcol%     ' column to start atπLOCATE row%, mcol%πPRINT text$;ππEND SUBπ'---------------------------------------------------------------------------πSUB cover(trow%, brow%, lcol%, rcol%, cnum%)ππnumcols% = (rcol% - lcol%) + 1      ' # of columns to coverππFOR x% = trow% TO brow%             ' for loop covers form toprow toπ LOCATE x%, lcol%                  ' bottomrow, numcol% wide withπ PRINT STRING$(numcols%, cnum%);   ' character(chr$) number (cnum%)πNEXT x%ππEND SUBπ'---------------------------------------------------------------------------πSUB lilshad (trow%, brow%, lcol%, rcol%)ππIF trow% = brow% THEN GOTO onelineππnumcol% = (rcol% - lcol%) + 1πLOCATE brow% + 1, lcol% + 1: PRINT STRING$(numcol%, 223);πLOCATE trow%, rcol% + 1: PRINT CHR$(220);ππFOR x% = trow% + 1 TO brow%π LOCATE x%, rcol% + 1π PRINT CHR$(219);πNEXT x%πEXIT SUBππoneline:           ' if just 1 rowππnumcol% = (rcol% - lcol%) + 1πLOCATE brow% + 1, lcol% + 1: PRINT STRING$(numcol%, 223);πLOCATE trow%, rcol% + 1: PRINT CHR$(220);ππEND SUBπ'---------------------------------------------------------------------------πSUB putwin(trow%, brow%, lcol%, rcol%, shad%, text$, fg%, bg%)ππ' putwin calls putbox to make initial boxπputbox trow%, brow%, lcol%, rcol%, 6, shad%, text$ ' border here must be 6πcolor fg%, bg%       ' must be reverse of original color for putwinπnumcols% = (rcol% - lcol%) + 1        ' # of columns to coverππFOR x% = trow% + 1 TO brow% - 1       ' leave border top and bottomπ LOCATE x%, lcol%π PRINT STRING$(numcols%, 0);          ' print nothing to cover (0)πNEXT x%ππFOR x% = trow% + 1 TO brow% - 1π LOCATE x%, lcol%: PRINT CHR$(221)    ' left borderπ LOCATE x%, rcol%: PRINT CHR$(222)    ' right borderπNEXT x%ππEND SUBπ'---------------------------------------------------------------------------πSUB putbox(trow%, brow%, lcol%, rcol%, bord%, shad%, text$)ππ SELECT CASE bord%π  CASE 1  ' single line borderπ   tlc$ = CHR$(218): tm$ = CHR$(196): trc$ = CHR$(191): s$ = CHR$(179)π   blc$ = CHR$(192): bm$ = CHR$(196): brc$ = CHR$(217)π  CASE 2  ' double line borderπ   tlc$ = CHR$(201): tm$ = CHR$(205): trc$ = CHR$(187): s$ = CHR$(186)π   blc$ = CHR$(200): bm$ = CHR$(205): brc$ = CHR$(188)π  CASE 3  ' double line top, single line sideπ   tlc$ = CHR$(213): tm$ = CHR$(205): trc$ = CHR$(184): s$ = CHR$(179)π   blc$ = CHR$(212): bm$ = CHR$(205): brc$ = CHR$(190)π  CASE 4  ' single line top, double line sideπ   tlc$ = CHR$(214): tm$ = CHR$(196): trc$ = CHR$(183): s$ = CHR$(186)π   blc$ = CHR$(211): bm$ = CHR$(196): brc$ = CHR$(189)π  CASE 5  ' thick line all sidesπ   tlc$ = CHR$(219): tm$ = CHR$(223): trc$ = CHR$(219): s$ = CHR$(219)π   blc$ = CHR$(219): bm$ = CHR$(220): brc$ = CHR$(219)π  CASE 6  ' no linesπ   tlc$ = CHR$(0): tm$ = CHR$(0): trc$ = CHR$(0): s$ = CHR$(0)π   blc$ = CHR$(0): bm$ = CHR$(0): brc$ = CHR$(0)π  CASE ELSE  ' single line if < 1 or > 6π   tlc$ = CHR$(218): tm$ = CHR$(196): trc$ = CHR$(191): s$ = CHR$(179)π   blc$ = CHR$(192): bm$ = CHR$(196): brc$ = CHR$(217)πEND SELECTππwide% = (rcol% - lcol%) - 1ππIF text$ > "" THEN         ' text$ is title if wantedπ widedif% = wide% - LEN(text$)π rwide% = widedif% - 3     ' put title 3 columns right of top-left cornerπ LOCATE trow%, lcol%π PRINT tlc$; STRING$(3, tm$); text$; STRING$(rwide%, tm$); trc$  ' top with titleπELSEπ LOCATE trow%, lcol%π PRINT tlc$; STRING$(wide%, tm$); trc$;   ' top with no titleπEND IFππFOR I% = trow% + 1 TO brow% - 1           ' for loop prints middleπ LOCATE I%, lcol%π PRINT s$; SPACE$(wide%); s$;πNEXT I%ππLOCATE brow%, lcol%πPRINT blc$; STRING$(wide%, bm$); brc$;    ' print bottomππIF shad% = 0 THEN EXIT SUB     ' if no shadow wanted (0) exit subππ' put shadow right side and bottom of boxππvideo& = vidseg&              ' call vidseg& functionπIF video& =  &hb000 THENπ EXIT SUB                     ' monochrome, no need for shadowπELSEπ DEF SEG = &hb800πEND IFππ' get present screen attributesπattr% = SCREEN(brow% + 1, rcol% + 1, -1)  ' get attributeπattr% = attr% AND 15                      ' get forgroundπattr% = attr% - 8                         ' dim if brightπIF attr% < 1 THEN attr% = 8               ' if wasn't brightπ' if don't want dim, 15 to 7 or 9 to 1, use 8 for attr%ππ' POKE shadow where needed...POKE right sideππFOR row% = trow% + 1 TO brow% + 1       ' 1 less than top, 1 greater than bottomπ FOR col% = rcol% + 1 TO rcol% + shad%  ' shad% is # columns, 1 or 2 usuallyπ  offset% = (row% - 1) * 160 + (col% - 1) * 2 + 1π  POKE offset%, attr%π NEXTπNEXTπ' POKE bottomπrow% = brow% + 1                        '1 row past bottomππFOR col% = lcol% + shad% TO rcol% + shad%   ' shad% is 1 or 2π offset% = (row% - 1) * 160 + (col% - 1) * 2 + 1π POKE offset%, attr%πNEXTππDEF SEGππEND SUBπ'---------------------------------------------------------------------------πSUB putscrn(scrn$)ππdef seg = vidseg&πpoke$ 0, scrn$πdef segππEND SUBπ'---------------------------------------------------------------------------πFUNCTION getscrn$()ππdef seg = vidseg&πgetscrn$ = peek$(0, 4000)    ' 1 screen colorπdef segππEND FUNCTIONππ'---------------------------------------------------------------------------πFUNCTION vidseg&()ππDEF SEG = 0πIF PEEK(&h463) = &hb4 THENπ vidseg& = &hb000πELSEπ vidseg& = &hb800πEND IFπDEF SEGππEND FUNCTIONπ'---------------------------------------------------------------------------πSUB hold()ππWHILE NOT INSTATπLOOPπDOπLOOP UNTIL INKEY$ = ""ππEND SUBπDarryl Schneider               INTERNET SEARCH UTILITY        [e-mail]            07-15-96 (22:07)       QB, QBasic, PDS        456  15236    QSEARCH.BAS 'This is a little internet search utility thatπ'searches all of the web sites or newsgroups inπ'its database, depending on the keyword you typeπ'in. Modify it by adding your own sites to theπ'database. It might be kind of hard to read,π'despite the fact I added in a few comments.π'Oh well, as long as it works! Enjoy :)π'π'Written by Darryl Schneiderπ'E-mail: [e-mail]π'The QBasic Zoneπ'http://www.geocities.com/SiliconValley/8191/π'πSCREEN 12ππDIM BCURSOR(1 TO 500)              'draw the little arrow cursorπLINE (50, 50)-(50, 60), 1          'Throughout the program I doπLINE (50, 50)-(70, 55), 1          'not use PSET to move the cursor.πLINE (50, 60)-(70, 55), 1          'Instead I just cover up my tracksπPAINT (55, 55), 3, 1               'with LINE (), , B and move ahead!πGET (50, 50)-(70, 60), BCURSOR     'Save the cursorππDEFSTR A, C-W                      'define some variablesπDEFINT X-YπDEFLNG ZπCASES = "N"                        'right now it is not case-sensitiveπSEARCHLIMITS = "NONE"              'there are no search limits setππMAINMENU:                          'start of the main menuπCLSπZTOTAL1 = 0                        'resets some variables to zeroπZTOTAL2 = 0πZTOTAL3 = 0πZHTML = 0πZFTP = 0πZNEW = 0πZHTMLT = 2                         'these next three are the numberπZFTPT = 2                          'of sites in each database. WhenπZNEWT = 2                          'you add a new site, make sure youπ                                   'increase the number correspondingπ                                   'to the database or else it won'tπ                                   'work properly!πENTER = CHR$(13)πUP = CHR$(0) + CHR$(72)πDOWN = CHR$(0) + CHR$(80)ππLINE (140, 46)-(500, 360), 9, BF        'draw the main menu screenπLINE (140, 46)-(500, 65), 11, BFπCOLOR 10: LOCATE 4, 35: PRINT "QuickSearch"πCOLOR 15: LOCATE 7, 25: PRINT "Enter keyword: "πCOLOR 12: LOCATE 10, 34: PRINT "Search Options"πCOLOR 15: LOCATE 13, 25: PRINT "Case-Sensitive: "; : COLOR 14: PRINT CASESπCOLOR 15: LOCATE 15, 25: PRINT "Search Limits: "; : COLOR 14: PRINT SEARCHLIMITS; " "πCOLOR 10: LOCATE 17, 25: PRINT "Search"πCOLOR 15: LOCATE 20, 25: PRINT "About QuickSearch"πCOLOR 15: LOCATE 22, 25: PRINT "End Search"ππMM1:                                        'all of the MM labels areπC1 = ""                                     'the different cursor locationsπPUT (168, 96), BCURSORπDOπC1 = INKEY$πIF C1 = ENTER THENπ         LOCATE 7, 40: INPUT "", KEYWORD        'input the keywordπ         GOSUB MM1                              'If you type "basic"πEND IF                                          'you get 5 of the 6πIF C1 = UP THEN                                 'sites displayedπ         LINE (168, 96)-(188, 106), 9, BFπ         GOSUB MM6πEND IFπIF C1 = DOWN THENπ         LINE (168, 96)-(188, 106), 9, BFπ         GOSUB MM2πEND IFπLOOPππMM2:πC2 = ""πPUT (168, 192), BCURSORπDOπC2 = INKEY$πIF C2 = ENTER THENπ         SELECT CASE CASESπ               CASE "N"                  'change to case-sensitiveπ                   CASES = "Y"π                   LOCATE 13, 41: COLOR 14: PRINT CASESπ                   COLOR 15π                   GOSUB MM2π               CASE "Y"                   'change to case-insensitiveπ                   CASES = "N"π                   LOCATE 13, 41: COLOR 14: PRINT CASESπ                   COLOR 15π                   GOSUB MM2π         END SELECTπEND IFπIF C2 = UP THENπ         LINE (168, 192)-(188, 202), 9, BFπ         GOSUB MM1πEND IFπIF C2 = DOWN THENπ         LINE (168, 192)-(188, 202), 9, BFπ         GOSUB MM3πEND IFπLOOPππMM3:                              'this label grouping changes theπC3 = ""                           'search limitsπPUT (168, 226), BCURSORπDOπC3 = INKEY$πIF C3 = ENTER THENπ         IF SEARCHLIMITS = "NONE" THENπ                SEARCHLIMITS = "HTML"π                LOCATE 15, 40: COLOR 14: PRINT SEARCHLIMITSπ                COLOR 15π                GOSUB MM3π         END IFπ         IF SEARCHLIMITS = "HTML" THENπ                SEARCHLIMITS = "FTP"π                LOCATE 15, 40: COLOR 14: PRINT SEARCHLIMITS; " "π                COLOR 15π                GOSUB MM3π         END IFπ         IF SEARCHLIMITS = "FTP" THENπ                SEARCHLIMITS = "NEWS"π                LOCATE 15, 40: COLOR 14: PRINT SEARCHLIMITSπ                COLOR 15π                GOSUB MM3π         END IFπ         IF SEARCHLIMITS = "NEWS" THENπ                SEARCHLIMITS = "NONE"π                LOCATE 15, 40: COLOR 14: PRINT SEARCHLIMITSπ                COLOR 15π                GOSUB MM3π         END IFπEND IFπIF C3 = UP THENπ         LINE (168, 226)-(188, 236), 9, BFπ         GOSUB MM2πEND IFπIF C3 = DOWN THENπ         LINE (168, 226)-(188, 236), 9, BFπ         GOSUB MM4πEND IFπLOOPππMM4:πC4 = ""πPUT (168, 258), BCURSORπDOπC4 = INKEY$πIF C4 = ENTER THENπ         GOSUB STARTSEARCH           'begin the search!πEND IFπIF C4 = UP THENπ         LINE (168, 258)-(188, 268), 9, BFπ         GOSUB MM3πEND IFπIF C4 = DOWN THENπ         LINE (168, 258)-(188, 268), 9, BFπ         GOSUB MM5πEND IFπLOOPππMM5:πC5 = ""πPUT (168, 306), BCURSORπDOπC5 = INKEY$πIF C5 = ENTER THENπ         GOSUB ABOUT             'go to the about screenπEND IFπIF C5 = UP THENπ         LINE (168, 306)-(188, 316), 9, BFπ         GOSUB MM4πEND IFπIF C5 = DOWN THENπ         LINE (168, 306)-(188, 316), 9, BFπ         GOSUB MM6πEND IFπLOOPπMM6:πC6 = ""πPUT (168, 338), BCURSORπDOπC6 = INKEY$πIF C6 = ENTER THENπ         GOSUB QUIT                             'quitπEND IFπIF C6 = UP THENπ         LINE (168, 338)-(188, 348), 9, BFπ         GOSUB MM5πEND IFπIF C6 = DOWN THENπ         LINE (168, 338)-(188, 348), 9, BFπ         GOSUB MM1πEND IFπLOOPππSTARTSEARCH:πCLSπIF KEYWORD = "" THEN GOSUB MAINMENUπIF CASES = "N" THEN KEYWORD = UCASE$(KEYWORD)πPRINT "               QuickSearch Results for query: "; : COLOR 14: PRINT KEYWORDπCOLOR 15πPRINT ""πIF SEARCHLIMITS = "NONE" THEN GOSUB SEARCH1     'a little filter dependingπIF SEARCHLIMITS = "HTML" THEN GOSUB SEARCH1     'on the search limitsπIF SEARCHLIMITS = "FTP" THEN GOSUB SEARCH2πIF SEARCHLIMITS = "NEWS" THEN GOSUB SEARCH3ππSEARCH1:πRESTORE HTMLSITES                  'finds all the HTML sitesπNEXTHTML:πIF ZHTML = ZHTMLT THENπ        Y1 = 1π        IF SEARCHLIMITS = "NONE" THENπ                IF ZTOTAL1 = 1 THEN ZTOTAL2 = 1π                IF ZTOTAL1 = 2 THEN ZTOTAL2 = 2π                IF ZTOTAL1 = 3 THEN ZTOTAL2 = 3π                IF ZTOTAL1 = 4 THEN ZTOTAL2 = 4π                GOSUB SEARCH2π        END IFπ        IF SEARCHLIMITS = "HTML" THEN GOSUB NOMOREπEND IFπPREV1:πREAD HTMLSITE, HTMLADDRESS, HTMLDESCRIPTION, HTMLDESCRIPTION2πIF CASES = "N" THEN GOSUB HTMLUPπIF CASES = "Y" THEN GOSUB HTMLLOWπHTMLUP:π                IF INSTR(UCASE$(HTMLSITE), UCASE$(KEYWORD)) > 0 THENπ                COLOR 13: PRINT HTMLSITEπ                COLOR 11: PRINT "       "; HTMLDESCRIPTIONπ                PRINT "         "; HTMLDESCRIPTION2π                COLOR 12: PRINT "       http://"; HTMLADDRESSπ                COLOR 15:π                PRINT ""π                ZTOTAL1 = ZTOTAL1 + 1π                ZHTML = ZHTML + 1π                IF ZHTML = ZHTMLT THEN GOSUB NEXTHTMLπ                IF ZTOTAL1 = 4 THEN GOSUB NEXTPAGEπ                GOSUB NEXTHTMLπ        ELSEπ                ZHTML = ZHTML + 1π                GOSUB NEXTHTMLπ        END IFπHTMLLOW:       π         IF INSTR(HTMLSITE, KEYWORD) > 0 THENπ                COLOR 13: PRINT HTMLSITEπ                COLOR 11: PRINT "       "; HTMLDESCRIPTIONπ                PRINT "         "; HTMLDESCRIPTION2π                COLOR 12: PRINT "       http://"; HTMLADDRESSπ                COLOR 15:π                PRINT ""π                ZTOTAL1 = ZTOTAL1 + 1π                ZHTML = ZHTML + 1π                IF ZHTML = ZHTMLT THEN GOSUB NEXTHTMLπ                IF ZTOTAL1 = 4 THEN GOSUB NEXTPAGEπ                GOSUB NEXTHTMLπ        ELSEπ                ZHTML = ZHTML + 1π                GOSUB NEXTHTMLπ        END IFππSEARCH2:πRESTORE FTPSITES                     'finds the FTP sitesπNEXTFTP:πIF ZFTP = ZFTPT THENπ        Y2 = 1π        IF SEARCHLIMITS = "NONE" THENπ                IF ZTOTAL2 = 1 THEN ZTOTAL3 = 1π                IF ZTOTAL2 = 2 THEN ZTOTAL3 = 2π                IF ZTOTAL2 = 3 THEN ZTOTAL3 = 3π                IF ZTOTAL2 = 4 THEN ZTOTAL3 = 4π                GOSUB SEARCH3π        END IFπ        IF SEARCHLIMITS = "FTP" THEN GOSUB NOMOREπEND IFπIF ZTOTAL2 = 4 THEN GOSUB NEXTPAGEπPREV2:πREAD FTPSITE, FTPADDRESS, FTPDESCRIPTION, FTPDESCRIPTION2πIF CASES = "N" THEN GOSUB FTPUPπIF CASES = "Y" THEN GOSUB FTPLOWπFTPUP:π                IF INSTR(UCASE$(FTPSITE), UCASE$(KEYWORD)) > 0 THENπ                COLOR 13: PRINT FTPSITEπ                COLOR 11: PRINT "       "; FTPDESCRIPTIONπ                PRINT "         "; FTPDESCRIPTION2π                COLOR 12: PRINT "       ftp://"; FTPADDRESSπ                COLOR 15:π                PRINT ""π                ZTOTAL2 = ZTOTAL2 + 1π                ZFTP = ZFTP + 1π                IF ZFTP = ZFTPT THEN GOSUB NEXTFTPπ                IF ZTOTAL2 = 4 THEN GOSUB NEXTPAGEπ                GOSUB NEXTFTPπ        ELSEπ                ZFTP = ZFTP + 1π                GOSUB NEXTFTPπ        END IFπFTPLOW:π                IF INSTR(FTPSITE, KEYWORD) > 0 THENπ                COLOR 13: PRINT FTPSITEπ                COLOR 11: PRINT "       "; FTPDESCRIPTIONπ                PRINT "         "; FTPDESCRIPTION2π                COLOR 12: PRINT "       ftp://"; FTPADDRESSπ                COLOR 15:π                PRINT ""π                ZTOTAL2 = ZTOTAL2 + 1π                ZFTP = ZFTP + 1π                IF ZFTP = ZFTPT THEN GOSUB NEXTFTPπ                IF ZTOTAL2 = 4 THEN GOSUB NEXTPAGEπ                GOSUB NEXTFTPπ        ELSEπ                ZFTP = ZFTP + 1π                GOSUB NEXTFTPπ        END IFππSEARCH3:πRESTORE NEWSITES                       'finds some newsgroupsπNEXTNEW:πIF ZNEW = ZNEWT THENπ        IF SEARCHLIMITS = "NONE" THEN GOSUB NOMOREπ        IF SEARCHLIMITS = "NEWS" THEN GOSUB NOMOREπEND IFπIF ZTOTAL3 = 4 THEN GOSUB NEXTPAGEπPREV3:πREAD NEWSITE, NEWDESCRIPTION, NEWDESCRIPTION2πIF CASES = "N" THEN GOSUB NEWUPπIF CASES = "Y" THEN GOSUB NEWLOWπNEWUP:π                IF INSTR(UCASE$(NEWSITE), UCASE$(KEYWORD)) > 0 THENπ                COLOR 13: PRINT NEWSITEπ                COLOR 11: PRINT "       "; NEWDESCRIPTIONπ                PRINT "         "; NEWDESCRIPTION2π                COLOR 15:π                PRINT ""π                ZTOTAL3 = ZTOTAL3 + 1π                ZNEW = ZNEW + 1π                IF ZNEW = ZNEWT THEN GOSUB NEXTNEWπ                IF ZTOTAL3 = 4 THEN GOSUB NEXTPAGEπ                GOSUB NEXTNEWπ        ELSEπ                ZNEW = ZNEW + 1π                GOSUB NEXTNEWπ        END IFπNEWLOW:π                IF INSTR(NEWSITE, KEYWORD) > 0 THENπ                COLOR 13: PRINT NEWSITEπ                COLOR 11: PRINT "       "; NEWDESCRIPTIONπ                PRINT "         "; NEWDESCRIPTION2π                COLOR 15:π                PRINT ""π                ZTOTAL3 = ZTOTAL3 + 1π                ZNEW = ZNEW + 1π                IF ZNEW = ZNEWT THEN GOSUB NEXTNEWπ                IF ZTOTAL3 = 4 THEN GOSUB NEXTPAGEπ                GOSUB NEXTNEWπ        ELSEπ                ZNEW = ZNEW + 1π                GOSUB NEXTNEWπ        END IFππNOMORE:                             'no more matches to the keywordπLOCATE 25, 5: PRINT "No more matches...press enter to return to the main menu..."πDOπD2 = UCASE$(INKEY$)πIF D2 = ENTER THEN GOSUB MAINMENUπLOOPππ'databasesππHTMLSITES:πDATA The QBasic Zone, www.geocities.com/SiliconValley/8191/, - Includes programs; tutorials; compilers; a huge, list of links and much more!πDATA The All Basic Code Home Page, charlie.simplenet.com/abc/abchome.html, - Has ABC packets filled with tons of, source code for you to use.ππFTPSITES:πDATA M / K Productions, members.aol.com/blood225/, - Lots of files to download,πDATA SimTel MSDOS Basic, oak.oakland.edu/SimTel/msdos/basic/, An archive of files to download,ππNEWSITES:πDATA comp.lang.basic.misc, - Discussion of any BASIC programming language,πDATA alt.lang.basic, - Discussion of all the BASIC programming languages,ππ'end of databasesππABOUT:                     'the infamous about screenπCLSπPRINT "                   About QuickSearch"πPRINT ""πPRINT "QuickSearch was written in Microsoft QuickBasic by 14-year old Darryl"πPRINT "Schneider. It is designed to be an off-line search utility so you"πPRINT "do not have to go back and forth while 'web surfing' to search for"πPRINT "the address of a web site. Above this in the source code are the"πPRINT "DATA statements for HTML and FTP sites, as well as Newsgroups. You"πPRINT "may add your own sites to the list, and build up a large database."πPRINT "With the HTML and FTP databases, the first series of words is the title"πPRINT "of the site, the next series is the address, next the first line of the"πPRINT "description, and then the second line of description. It is the same for"πPRINT "newsgroups except there is no address. At the main menu you can have"πPRINT "a case-sensitive or non-sensitive search, and can search with no"πPRINT "limits (None), only in HTMLs (HTML), only in FTPs (FTP), or only in"πPRINT "newsgroups (NEWS), by cycling through pressing enter. I hope that this"πPRINT "application proves useful in some way and helps you with programming"πPRINT "or your web surfing!"πPRINT ""πPRINT "Press enter to return to the main menu..."πDOπD3 = UCASE$(INKEY$)πIF D3 = ENTER THEN GOSUB MAINMENUπLOOPππQUIT:πENDππNEXTPAGE:πLOCATE 25, 5: PRINT "Press enter for more or 'Q' to quit..."πDOπD1 = UCASE$(INKEY$)               'goes to the next page after 4πIF D1 = ENTER THEN                'sites have been displayedπ        IF Y1 = 1 THEN GOSUB NEXT2π        IF ZTOTAL1 = 4 THENπ           IF ZHTML = ZHTMLT THEN GOSUB NEXTHTMLπ           ZTOTAL1 = 0π           CLSπ           PRINT "               QuickSearch Results for query: "; : COLOR 14: PRINT KEYWORDπ           PRINT ""π           COLOR 15π           GOSUB PREV1π        END IFπNEXT2:     π        IF Y2 = 1 THEN GOSUB NEXT3π        IF ZTOTAL2 = 4 THENπ           IF ZFTP = ZFTPT THEN GOSUB NEXTFTPπ           ZTOTAL2 = 0π           CLSπ           PRINT "               QuickSearch Results for query: "; : COLOR 14: PRINT KEYWORDπ           PRINT ""π           COLOR 15π           GOSUB PREV2π        END IFπNEXT3:π        IF ZTOTAL3 = 4 THENπ           IF ZNEW = ZNEWT THEN GOSUB NEXTNEWπ           ZTOTAL3 = 0π           CLSπ           PRINT "               QuickSearch Results for query: "; : COLOR 14: PRINT KEYWORDπ           PRINT ""π           COLOR 15π           GOSUB PREV3π        END IFπEND IFπIF D1 = "Q" THEN GOSUB MAINMENUπLOOPππ'end of QuickSearchπChristoph Kummetat             PROGRAM THE PARALLEL PORT      FidoNet QUIK_BAS Echo          07-13-96 (13:44)       QB, QBasic, PDS        125  5033     PARALLEL.BAS'> With 8 data lines I have many options and combinations thereof. I amπ'> not familair with the bit structure of characters. Any clue as to howπ'> to go about deciding the characters to use that would activate lineπ'> "1" only while leaving the others alone?ππ'here's some code, which might help you to program the parallel port. π'Originally it is a programm to set 8 relais via LPT. I shortened it to the π'important things. If you have more questions about, feel free to ask me...ππInitVar:π   DEFINT A-Zπ   DIM SHARED Bit(8), BitStatus, Port, RelNrπ   DIM SHARED Anzahl(8)ππ   CONST Blk = 0, Blu = 1, Grn = 2, Zyn = 3, Red = 4  'set colorsπ   CONST Gry = 7, Yel = 14, Wht = 15, Blink = 16π   CONST TRUE = 1, FALSE = NOT TRUE                   'set booleanππ   CLS : Count = 1π   FOR i = 1 TO 8π      Bit(i) = Count                                  'set bits with bit-valuesπ      Count = Count + Count                           'increase values (0,1,2,4,8,16,32,64,128)π   NEXT iππ   CALL DATEN.Find.LPT                                'search for LPTsππ   BitStatus = 0                                      'switch all lines OFFπ   OUT Port, BitStatus                                'send to LPTπ   CALL DATEN.Get.Status                              'read LPTπππWHILE INKEY$ <> "q"π   CALL DATEN.Set.Statusπ   FOR i = 1 TO 8π      CALL DATEN.Get.Statusπ   NEXT iπWENDππ      OUT Port, LEDStatus                                      'an par. SN sendenππSUB DATEN.Find.LPTπ   DEF SEG = 0: DIM Port(4)π   Count = 0: COLOR Wht, Bluπ   FOR i = 1032 TO 1036 STEP 2π      IF PEEK(i) + 256 * PEEK(i + 1) > 0 THENπ         Count = Count + 1π         Port(Count) = VAL("&H" + HEX$(PEEK(i) + 256 * PEEK(i + 1)))π         LOCATE 4 + Count, 6π         PRINT "Printerport"; STR$(Count); " : ";π         PRINT "&H" + HEX$(PEEK(i) + 256 * PEEK(i + 1))π      END IFπ   NEXT iπ   IF Count = 0 THEN                                          'no port foundπ      PRINT "No parallel port found on your PC !";π      ch$ = INPUT$(1)π      CLOSE : COLOR Wht, Blk: CLS : ENDπ   END IFππGetPrt:                                                        'choose LPTπ   LOCATE , 6: PRINT "Which parallel port do you want to use : ";π   v$ = INPUT$(1)                                              'ask for LPTπ   IF VAL(v$) < 1 OR VAL(v$) > Count THENπ      SOUND 3200, .3: GOTO GetPrt                              'invalid valueπ   END IFπ   Port = Port(VAL(v$))                                        'define portπEND SUBππSUB DATEN.Get.Statusπ     BitStatus = INP(Port)                                     'read LPTπ     FOR i = 1 TO 8π         IF BitStatus AND Bit(i) THENπ            Status = 1π         ELSEπ            Status = 0π         END IFπ     CALL DISPLAY.Status(i, Status)π     NEXT iπEND SUBππSUB DATEN.Relais.Resetπ     BitStatus = 0: OUT Port, BitStatus                        'reset all registers at LPTπEND SUBππSUB DATEN.Set.Status                                           'send value to LPTπ   COLOR Blk, Gry:π   LOCATE 12, 6: PRINT "which line to set ? : "π   LOCATE 13, 6: PRINT "(number 1 - 8 or 0 for all OUT)  "ππGetBit:π   v$ = INPUT$(1)                                              'number of LPTπ   BitNr = VAL(v$)π   IF ASC(v$) = 27 THEN COLOR Wht, Blk: CLS : END              'Escape, end programπ   IF BitNr > 8 THEN SOUND 3200, .3: GOTO GetBit               'hey, you can only choose between 1 and 8πGetSts:π   IF BitNr = 0 THENπ      BitStatus = 0                                            'switch all lines OFFπ      OUT Port, BitStatus                                      'send to LPTπ      CALL DISPLAY.Status(BitNr, BitStatus)                    'display statusπ   ELSEIF BitStatus AND Bit(BitNr) THEN                        'is line ON or OFF ?π      BitStatus = BitStatus XOR Bit(BitNr)                     'swith bit/line to OFFπ      OUT Port, BitStatus                                      'send to LPTπ      CALL DISPLAY.Status(BitNr, BitStatus)                    'display statusπ   ELSEπ      BitStatus = BitStatus + Bit(BitNr)                       'add bit/lineπ      OUT Port, BitStatus                                      'send to LPTπ      CALL DISPLAY.Status(BitNr, BitStatus)                    'display statusπ   END IFπEND SUBππSUB DISPLAY.Status (BitNr, Status)                             'show status of bits/linesπ   IF BitNr >= 1 THENπ      IF Status >= 1 THENπ         COLOR Wht, Red                                        'bit/line activeπ         LOCATE 8, ((BitNr * 8) + BitNr) - 3: PRINT "  ON  "π       ELSEπ         COLOR Wht, Grn                                        'bit/line inactiveπ          LOCATE 8, ((BitNr * 8) + BitNr) - 3: PRINT " OFF  "π      END IFπ   ELSEπ      COLOR Wht, Grn                                           'all bits/lines OFFπ         FOR i = 1 TO 8π         LOCATE 8, ((i * 8) + i) - 3: PRINT " OFF  "π      NEXT iπ   END IFπEND SUBπRobert Fortune                 BBS GAME PROGRAMMING           FidoNet QUIK_BAS Echo          04-14-96 (00:00)       QB, QBasic, PDS        245  8996     GAMESHEL.BAS'>statements, but the Real problem is, what if a new userπ'>wants to use the game? Can someone help... I need it toπ'>open the player.dat file, search for the Real Name, Loadπ'>The Data, And Save The Data in the right spot.... Canπ'>Someone Help Me?ππ'   I can try. The following code uses a random access file to keepπ'   scores for a BBS game. The PlayerName field is the key fieldπ'   that the code uses to keep track of the players and their scores,π'   etc... The code also creates an SCORES.ANS file which is just an ANSIπ'   high scores file that a SysOp can use on his BBS bulletin(s) menu. Youπ'   can modify as needed or use as a rough guide. It will reach you inπ'   2 messages as it's kind of long so you will need to edit it back intoπ'   a single file before running it. Hope it helps. Good luck!ππ' ----------------------- CUT HERE -------------CUT HERE ----------------πREM GAMESHEL.BAS  04/14/96πREM QB/QBX Demo game shell using a Random Access data file to store,πREM sort and display players names and scores. Also creates an ANSIπREM color high scores bulletin file (SCORES.ANS)ππDEFINT A-Z  ' all untyped variables default to type integerπDECLARE SUB MoveCursor (X%, Y%)           ' position cursor on screenπDECLARE SUB SetColors (FG%, BG%, Attrib%) ' set ANSI colors to useππREM Define our random access file structureπTYPE GameRecordπ     RecordNumber AS INTEGERπ     PlayerAlias AS STRING * 25π     PlayerName AS STRING * 25π     ExperPoints AS LONGπ     GoldOnHand AS LONGπ     GoldInBank AS LONGπ     Beauty AS LONGπ     GEMS AS LONGπ     PlayerScore AS LONGπ     PlayerDay AS STRING * 11πEND TYPEπDIM PlayerRecord AS GameRecord   ' reserve some memoryπDIM TempRecord AS GameRecordππCONST True = -1, False = NOT TrueπClrScrn$ = CHR$(27) + "[2J"      ' clear ANSI screenππOPEN "CONS:" FOR OUTPUT AS #1    ' local output via CONSole deviceππREM Open the random access players fileπOPEN "GAMEFILE.DAT" FOR RANDOM AS #2 LEN = LEN(PlayerRecord)ππREM Here is where you would normally get the player's name from the BBS dropπREM file (DOOR.SYS, PCBOARD.SYS, etc...). As an example we get the player'sπREM name manually. In a BBS game door you should get the info from the BBSπREM drop file.ππDOπ  CLSπ  LINE INPUT "Please enter your FULL Name: "; FullName$π  FullName$ = UCASE$(FullName$)πLOOP WHILE FullName$ = ""ππREM Search existing records for a match on player's full name.πREM We're using record number 1 for the All-Time-Winner recordπREM to keep all the player data in the same file.ππRecordNumber% = 1   ' this record is reserved for All-Time-WinnerπIF LOF(2) > 0 THEN  ' Any records in the file yet?π   DOπ      RecordNumber% = RecordNumber% + 1π      GET #2, RecordNumber%, PlayerRecordπ   LOOP UNTIL (RTRIM$(PlayerRecord.PlayerName) = FullName$) OR (EOF(2))πELSEπ   RecordNumber% = RecordNumber% + 1π   PlayerRecord.PlayerName = FullName$π   PlayerRecord.PlayerScore = 500  ' start each player with 500 pointsπ   PlayerRecord.PlayerDay = DATE$π   PUT #2, 1, PlayerRecordπ   PUT #2, 2, PlayerRecordπEND IFππREM Did we find a match?ππIF RTRIM$(PlayerRecord.PlayerName) <> FullName$ THEN ' No match, new playerπ   RecordNumber% = LOF(2) \ LEN(PlayerRecord) + 1π   PlayerRecord.PlayerName = FullName$π   PlayerRecord.PlayerScore = 500  ' start each player with 500 pointsπ   PlayerRecord.PlayerDay = DATE$π   PUT #2, RecordNumber%, PlayerRecordπEND IFπCLOSE #2ππScore# = PlayerRecord.PlayerScoreππStart:ππ' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *π' YOUR PROGRAM STARTS HEREπ' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *ππ' Somewhere in your game player would win/lose points as inππScore# = Score# + 10   ' demo score keeper for gameππ' More of your game programππ' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *π' YOUR GAME ENDS HERE. Now we need to update the player's scores.π' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *ππFinish:ππOPEN "GAMEFILE.DAT" FOR RANDOM AS #2 LEN = LEN(PlayerRecord)πOPEN "SCORES.ANS" FOR OUTPUT AS #3  ' open ANSI high scores bulletin fileππRecordNumber% = 2πGET #2, RecordNumber%, PlayerRecordπDO UNTIL RTRIM$(PlayerRecord.PlayerName) = FullName$π   RecordNumber% = RecordNumber% + 1π   GET #2, RecordNumber%, PlayerRecordπLOOPπPlayerRecord.PlayerScore = Score#πPlayerRecord.PlayerDay = DATE$ππREM See if we have a new All-Time-WinnerπGET #2, 1, TempRecordπIF PlayerRecord.PlayerScore > TempRecord.PlayerScore THENπ   PUT #2, 1, PlayerRecord    ' write a new all-time winner recordπEND IFππREM Write the updated player's record to random access highscores fileπPUT #2, RecordNumber%, PlayerRecordπ' (Disk) Sort players scores using basic bubblesort from MS QB Bible bookπDOπ   Switch = Falseπ   FOR I% = 2 TO (LOF(2) \ LEN(PlayerRecrd)) - 1π       GET #2, I%, PlayerRecordπ       GET #2, I% + 1, TempRecordπ       IF PlayerRecord.PlayerScore < TempRecord.PlayerScore THENπ          SWAP PlayerRecord, TempRecordπ          PUT #2, I%, PlayerRecordπ          PUT #2, I% + 1, TempRecordπ          Switch = Trueπ       END IFπ   NEXT IπLOOP WHILE Switchπ' Now print the players names and scores which are in sorted orderπ' in the GAMEFILE.DAT file (sorted on players' scores).ππPRINT #1, ClrScrn$        ' clear the screenπPRINT #3, ClrScrn$ππREM this is where the final score board starts .πGET #2, 1, PlayerRecordπCALL SetColors(33, 40, 1)  ' make screen colors bright yellow on blackππREM (Long line split to fit email line length)πText$ = "< < <  " + RTRIM$(PlayerRecord.PlayerName) + " won "πText$ = Text$ + LTRIM$(STR$(PlayerRecord.PlayerScore)) + " points on "πText$ = Text$ + PlayerRecord.PlayerDay + "  > > > "ππX% = 2                     ' print on 2nd line of screenπY% = 40 - LEN(Text$) \ 2   ' center the high scores titleπCALL MoveCursor(X%, Y%)    ' position the cursorπPRINT #1, Text$      ' print high scores title to the screenπPRINT #3, Text$      ' print high scores title to the SCORES.ANS fileπCALL SetColors(34, 40, 1) ' make screen colors bright blue on blackπText$ = "Last Played     Player                  Score"πX% = 4πY% = 40 - LEN(Text$) \ 2πCALL MoveCursor(X%, Y%)πPRINT #1, Text$πPRINT #3, Text$πCALL SetColors(31, 40, 1)   ' make screen colors bright red on blackπText$ = "-------------------------------------------------"πX% = X% + 1πY% = 40 - LEN(Text$) \ 2πCALL MoveCursor(X%, Y%)πPRINT #1, Text$πPRINT #3, Text$πCALL SetColors(32, 40, 1)   ' make screen colors bright green on blackπY% = Y% + 2πREM Print out the first 10 records in our random access fileπIF LOF(2) \ LEN(PlayerRecord) < 12 THENπ   Bottom% = LOF(2) \ LEN(PlayerRecord)πELSEπ   Bottom% = 11πEND IFπFOR I% = 2 TO Bottom%π    GET #2, I%, PlayerRecordπ    Text$ = PlayerRecord.PlayerDay + "      " + PlayerRecord.PlayerNameπ    Text$ = Text$ + "    " + STR$(PlayerRecord.PlayerScore)π    X% = X% + 1π    CALL MoveCursor(X%, Y%)π    PRINT #1, Text$π    PRINT #3, Text$πNEXT I%πREM Print an underline after top scores are displayedπCALL SetColors(31, 40, 1)   ' make screen colors bright red on blackπText$ = "================================================="πX% = X% + 1πY% = 40 - LEN(Text$) \ 2πCALL MoveCursor(X%, Y%)πPRINT #1, Text$πPRINT #3, Text$πCALL SetColors(40, 37, 1)  ' set screen colors bright white on blackπText$ = "[PRESS ANY KEY TO CONTINUE]"πX% = X% + 2πY% = 40 - LEN(Text$) \ 2πCALL MoveCursor(X%, Y%)πPRINT #1, Text$πDOπ   AnyKey$ = INKEY$πLOOP UNTIL LEN(AnyKey$)πCALL SetColors(37, 40, 0)  ' reset screen colors to drab white on blackπPRINT #1, ClrScrn$         ' clear the screenπCLOSE #1, #2, #3           ' All done. Close up all open filesπEND                        ' The Endππ' Position cursor on ANSI screen where X% = screen row position andπ' Y% = screen column position where X% can equal 1 thru 25 and Y%π' can equal 1 thru 80.πSUB MoveCursor (X%, Y%)πMove$ = CHR$(27) + "[" + LTRIM$(STR$(X%)) + ";"πMove$ = Move$ + LTRIM$(STR$(Y%)) + "H"πPRINT #1, Move$;πEND SUBππ' Set ANSI screen colorsπ' FG% = ANSI foreground color, BG% = ANSI background color.π' Valid fore colors (FG%)     Valid back colors (BG%)π' Black   30                        40π' Red     31                        41π' Green   32                        42π' Yellow  33                        43π' Blue    34                        44π' Magenta 35                        45π' Cyan    36                        46π' White   37                        47π' ANSI Attr% = attribute (bright(1), blink(5), reverse(7), reset(0)-π' cancelled(8), underline(4) (mono only else blue)πSUB SetColors (FG%, BG%, Attr%)π    Text$ = CHR$(27) + "[" + LTRIM$(STR$(Attr%)) + ";"π    Text$ = Text$ + LTRIM$(STR$(BG%)) + ";" + LTRIM$(STR$(FG%)) + "m"π    PRINT #1, Text$;π    PRINT #3, Text$;πEND SUBπRick Pedley                    SET NEW PRINTER TIMEOUT VALUE  QBTIPS_R.DOC                   10-09-93 (14:35)       QB, PDS                40   1403     TIMEOUT.BAS 'TIMEOUT.BAS π'Sets printer `timeout retry' value to help prevent `printer busy' π'errors. Most machines copy the value 20 (&h14) from the BIOS into π'three RAM addresses, corresponding to printer ports LPT1, 2, and 3. π'Before DOS gives a printer busy error, it cycles 20 x ~260,000 π'times to see if the error has cleared. On a fast computer, say a π'50 MHz 486, this _may_ not be long enough and even copying a file π'to the printer from DOS may cause a R)etry, A)bort, F)ail to be π'displayed. This utility can be run from the DOS prompt or in your π'AUTOEXEC.BAT. If no parameter is specified, it prints the current π'values for each port and a short message. If you regularly get π'printer busy errors even in DOS, run this utility trying different π'values, starting with something greater than 20, until the errors π'disappear. π' π'R. Pedley, 93-10-09 π πDEFINT A-Z πDEF SEG = 64        '0040 πIF LEN(COMMAND$) THEN π   T = VAL(COMMAND$) π   IF T > 0 AND T < 256 THEN π      POKE 120, T   '    :0078 π      POKE 121, T   '    :0079 π      POKE 122, T   '    :007A π   ELSE π      BEEP π   END IF πEND IF πPRINT πPRINT "Current printer timeout values are:" πPRINT πPRINT "LPT1:"; PEEK(120) πPRINT "LPT2:"; PEEK(121) πPRINT "LPT3:"; PEEK(122) πPRINT πPRINT "To set a new value, use a parameter between 1 and 255," πPRINT "e.g. TIMEOUT 45" πPRINT πDEF SEG πRobert Fortune                 ACCESSING COM PORT VIA INT 14  FidoNet QUIK_BAS Echo          08-26-96 (11:39)       QB, PDS                239  10367    BIOSCOM.BAS '-> Sorry, but that's the way QuickBasic does it. You have to useπ'-> OPEN/CLOSE to read/write to files as well as COMPORTS.ππ'>       Actually, I found this in a help file:ππ'>INARY%(AX) = &H3C00            ' DOS function to create a file.π'>INARY%                         ' DOS attribute for created file.ππ'>       It appears that you can use Interrupts to work with files (andπ'>probably devices such as commports).  I bet someone here could use the aboveπ'>(or they might not even need it) to create their own OPEN/CLOSE SUBs andπ'>other SUBs to work with the files such as writing to, reading from, andπ'>getting information like LOF and EOF.ππ'   Yes you can. Here is some play code I've fiddled around with. It isn'tπ'   error-proof but it does demonstrate using BIOS Int 14h to access a comπ'   port. You would use similar code to access a FOSSIL driver (BNU, X00...)π'   The demo code doesn't do anything but reset\init modem, dial out andπ'   then hang up. It does show how to use interrupts to access a com port.ππ' --------- CUT HERE -------------------- CUT HERE ---------------------------πREM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *πREM *  BIOSCOM.BAS    8/26/1996                                           *πREM *  Demo QB code to access a serial port via BIOS INT 14h using        *πREM *  QB\PDS.  YOU MUST start QB\PDS with the /L command line switch to  *πREM *  allow QB to call BIOS interrupt 14H as in:   QB BIOSCOM /L         *πREM *                                                                     *πREM *  Maximum baud rate BIOS Int 14H reliably supports is 9600 BPS.      *πREM *  This demo program uses 9600 BPS on COM 2 with NO parity, one Stop  *πREM *  Bit and eight Data Bits. Modify as needed. - RAF                   *πREM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *πDEFINT A-Z    ' All untyped variables default to type integerπ'$INCLUDE: 'REGTYPE.BI'ππDECLARE SUB InitPort (PortNum%, BaudRate%)πDECLARE SUB GetStatus ()πDECLARE SUB Get1Byte (Byte$)πDECLARE SUB GetStr (Text$)πDECLARE SUB Send1Byte (Byte$)πDECLARE SUB SendStr (Text$)πDECLARE FUNCTION Dec2Bin$ (b%) ' Useful function for determining com parmsππDIM SHARED Registers AS RegTypeπDIM SHARED ComPort%, BaudRate%, Parity%, StopBits%, DataBits%ππREM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *πREM *   Example QB code to test BIOS INT 14H to access a serial port      *πREM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *ππComPort% = 1      ' zero-based so 1 is actually com 2 (com 1 would be 0)πBaudRate% = 9600  ' 9600 BPS (max that BIOS INT 14H reliably supports)πParity% = 16      ' use NO parity        00010000πStopBits% = 0     ' use one Stop bit     00000x00πDataBits% = 3     ' use eight Data bits  00000011ππREM * * * * * * * * * * * * MAIN PROGRAM CODE * * * * * * * * * * * * * * *πCR$ = CHR$(13)    ' ASCII code for carriage return\ENTERπESC$ = CHR$(27)   ' ASCII code the the ESC keyπCLSπPRINTπCALL InitPort(ComPort%, BaudRate%)πPRINTπPRINT "Testing BIOS Interrupt 14H in QB\PDS to access a serial port."πPRINTπPRINT "Communications Port:" + STR$(ComPort% + 1)πPRINT "BPS Rate: " + STR$(BaudRate%)πPRINT "Resetting com port "; LTRIM$(STR$(ComPort% + 1)); "...";ππByteStr$ = ""πText$ = "ATZ" + CR$     ' initialize\reset modem to use modem profile 0πCALL SendStr(Text$)ππREM Wait for an OK from the modem that it received our modemπREM reset command.πDOπ  CALL GetStr(Text$)πLOOP UNTIL INSTR(Text$, "OK")  ' u might wanna check for error(s) hereπPRINT "done!"πPRINTπPRINTππREM Dial a number. Best to dial your own phone number here which willπREM ensure a BUSY signal and not annoy anyone.ππLINE INPUT "Enter your telephone number: "; Number$πIF Number$ = "" THEN Number$ = "555-1212"  ' Information please? <g>πPRINTπText$ = "ATDT" + Number$ + CR$ ' ATDT touch tone line (ATDP for pulse line)πCALL SendStr(Text$)            ' And dial outππREM Wait for a BUSY or CONNECT from the modem to be sure that the modemπREM received our DIAL command properly. In a real world program you wouldπREM need to check for other conditions like NO CARRIER, etc...πPRINT "Press ESC key to cancel"πPRINTπByteStr$ = ""πDOπ  CALL Get1Byte(Byte$)π  ByteStr$ = ByteStr$ + Byte$π  PRINT Byte$;π  AnyKey$ = INKEY$π  IF AnyKey$ <> "" THEN EXIT DOπLOOP UNTIL INSTR(ByteStr$, "BUSY") OR INSTR(ByteStr$, "CONNECT")πPRINTπPRINT "Hanging up...";πText$ = "ATH0" + CR$    ' force the modem to hang upπCALL SendStr(Text$)πPRINT "All done Bubba!"πEND  ' The End.πREM * * * * * * * * * * * * * THE END * * * * * * * * * * * * * * * * * * *ππREM * * * * * * * * * * * * * * * * * * * * * * * * *πREM  Converts a decimal number into a binary string.πREM  Called with:  b% which is an integer variableπREM  Returns:  binary value of integer b%πREM * * * * * * * * * * * * * * * * * * * * * * * * *πFUNCTION Dec2Bin$ (b%) STATICπTemp$ = ""πH$ = HEX$(b%)πFOR I% = 1 TO LEN(H$)π    Digit% = INSTR("0123456789ABCDEF", MID$(H$, I%, 1)) - 1π    IF Digit% < 0 THENπ       Temp$ = ""π       EXIT FORπ    END IFπ    J% = 8π    K% = 4π   DO  ' convert from hexadecimal to binaryπ       Temp$ = Temp$ + RIGHT$(STR$((Digit% \ J%) MOD 2), 1)π       J% = J% - (J% \ 2)π       K% = K% - 1π       IF K% = 0 THEN EXIT DOπ   LOOP WHILE J%πNEXT I%πDec2Bin$ = Temp$πEND FUNCTIONπREM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *πREM   Receives one byte from active port via BIOS INT 14H - Function 2πREM   Called with: AH = 2πREM                DX = serial port 0 to 3 (zero-based)πREM   Returns: AH = Line StatusπREM            AL = Byte recievedπREM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *πSUB Get1Byte (Byte$)π   PortFunc% = 2      ' Int 14H Function 2 = Read Char from portπ   AL% =  0           ' zero-out, unused with this functionπ   Registers.AX = AL% + (256 * PortFunc%)π   Registers.DX = ComPort%  ' com port (zero-based, com 1 is zero, etc...)π   CALL INTERRUPT(&H14, Registers, Registers)π   Byte$ = CHR$(Registers.AX AND 255) ' return string of ASCII char rec'dπEND SUBππREM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *πREM  Reads line and modem status of the specified com portπREM  Called with:  AH = 3  ' function 3 (Get status) of INT 14HπREM                DX = serial port 0 to 3 (zero-based)πREM  Returns:  AH = Line StatusπREM            AL = Modem StatusπREM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *πSUB GetStatusπ    AL% = 0          ' zero out AL register halfπ    AH% = 3          ' Int 14H Function 3 = Read line and modem statusπ    Registers.AX = AL% + (256 * AH%)π    Registers.DX = ComPort%  ' zero based active com port numberπ    CALL INTERRUPT(&H14, Registers, Registers)π    LineStat% = Registers.AX \ 256       ' extract AH from AX registerπ    ModemStat% = Registers.AX AND 255    ' extract AL from AX registerπEND SUBππREM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *πREM  Gets a string from the active com port one byte at a time usingπREM  INT 14H's Get Byte function (2). *See Get1Byte SUBπREM  Example:  CALL GetStr(Text$)πREM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *πSUB GetStr (Text$)π DOπ   CALL Get1Byte(Byte$)π   Text$ = Text$ + Byte$π LOOP WHILE Byte$ <> CHR$(13)  ' loop till a carriage return is rec'dπEND SUBππREM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *πREM  Opens and initializes the com port via BIOS INT 14h (Function 0).πREM  Registers set before calling:πREM           AH = INT 14H function we want to invoke ( 0 = initialize port)πREM           AL = Serial port initialization values (Baud, Parity...)πREM           DX = com port number (zero based, 0 is com 1, 1 is com 2...)πREM  Returns:  AH = Line StatusπREM            AL = Modem StatusπREM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *πSUB InitPort (ComPort%, BaudRate%)π  SELECT CASE BaudRate%    ' max baud via BIOS INT 14H is 9600 BPSπ         CASE 9600π              BaudVal% = 128 + 64 + 32  ' (224) = binary 11100000π         CASE 2400π              BaudVal% = 128 + 32       ' (160) = binary 10100000π         CASE 1200π              BaudVal% = 128            ' (128) = binary 10000000π         CASE 300π              BaudVal% = 64             ' (64)  = binary 01000000π  END SELECTπ  ComParms% = BaudVal% + Parity% + StopBits% + DataBits%π  PortFunc% = 0 ' Function 0 (of Int 14H) which is init portπ  Registers.AX = ComParms% + (256 * PortFunc%)π  Registers.DX = ComPort%  ' active com port to init (zero-based)π  CALL INTERRUPT(&H14, Registers, Registers) ' call the interruptπEND SUBππREM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *πREM  Sends one byte to the specified serial port (zero based ComPort) via -πREM  Function 1 of BIOS INT 14HπREM  Called with: AH = 1πREM               AL = ASCII value of the byte to sendπREM               DX = Serial port 0 to 3 (zero based; use 0 for port 1...)πREM  Returns:  AH = Line StatusπREM            AL = unchanged (the byte that was sent)πREM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *πSUB Send1Byte (Byte$)π    PortFunc% = 1      ' INT 14H Function 1 = write char to port goes into AHπ    Byte% = ASC(Byte$) ' ASCII value of byte which goes into ALπ    Registers.AX = Byte% + (256 * PortFunc%)π    Registers.DX = ComPort%  ' com port number (zero-based)π    CALL INTERRUPT(&H14, Registers, Registers)πEND SUBππREM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *πREM  Sends a string to the active com port one byte at a time usingπREM  INT 14H's Send Byte function (1).πREM  Called with:  Text$ which is the string to send out the com port.πREM  Example:  CALL SendStr(Text$)πREMπREM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *πSUB SendStr (Text$)π    FOR I% = 1 TO LEN(Text$)π        OneByte$ = MID$(Text$, I%, 1)π        CALL Send1Byte(OneByte$)π    NEXT I%πEND SUBπ' --------- CUT HERE -------------------- CUT HERE ---------------------------πErik Bruggema                  REMOTE ACCESS UTILITIES        [e-mail]        08-28-96 (18:27)       QB, QBasic, PDS        77  5021     RA_UTILS.BASDEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"RA_UTILS.ZIP",4^6:Z&=3487:?STRING$(50,177);πU"%up()%9%%%I-%K'mAF8b1Cb6'7%%#-%%%1%%%%qf%xyhf%qqSg7fx&y1r^jUa95πU"lC)NGoP^*yRS5sCtz14__QAa(6G?.FJ2U[ZCia/aFxc7wEB-[)w;o&tBqNFGg6sπU"d5Xr8OmVQmnv=mUu%bG^)OuG+N1.I7]3;2_KP>Ur-uW*;p/Vhjx;K*3)t'm&-M?πU"Ej[V$s#e/mi+/j1ma2WCt#ovoEF98R=eb9)2cI+5^G(lQ7cCZ(Zn8V9\TT3.q;8πU"#3r#[]/%f8Odmse0D5L^M;m+w*H]RD;$+s#mA8+yC*F0o\M1Z0'bbj1>I]MDm#iπU"Fg9#ifJo8[<uTOwm9j;Z3f:Yo,0)zw>&4EGmcE700LxYBr:0bbEis?2^DH<.c[tπU"2oEtB#PuwwP5nFaaBoi:55hPJGArLckj0A4&E56IGY4C&QRbwh[$BJsAQ;0QU)1πU"T,SATHp9Y'bpNrmA3-'M<'$U+%D0/[VJN&LK6iF;S<^e:7)o8c%D/UVqO_(F;7wπU"OSDjBnoS^j?Vr7$V]VhL)V]1iQrI\pK3$vh-pi5+j6*qB,)FOAZ#_ru\B9PuqOKπU"Q]qbMQiN+Ia(r+q7m8mxTcC$6IB6S7DA'/>R2KbI7Z+'Jp9J=cE]th(v&Tc&)qbπU";Fgu59rS&[4rtyoW#pc_l8?n&X[F4etuk/(AHVJTcUdU.<QXS[DoVQRBf5J?hqxπU"%m&_iA^U,KuzrGcT:$3<-u;SJ94MMGxd441_1N#hO^dioId'KfxaSrN]+uT3--9πU"(O[B3lyvLup3fvfo:f*dPW2(rR[nJLD:)haD(^$100Z=)5l=9XN(Z('F-H.bb&TπU"J&Nup(%)9%%[%-%S[g#FXAR$(<[%%%e%%%%1%%%%q%fxyh%fqqS#ggx2c]iRKmxπU"-GDUT&dAh00Et+<9;[>Ph>s-?_HAu(RN3_,3b3>N9NaO.aB2%(Pa3#v\6s&=,HhπU"J+a6IP_8nvPn4zn'S'h$B&L&(=1xD]<wf*rD//U32///Z-))WWMS_[Cc*N-N&%HπU"k%%up()%9%%%I-%s%%AF2O&>kZ&.%%A'%%%0%#%%x(%xnsk%tSgf^xDvJ+o<U98πU"L4]D73zQO',Uj5p*pVKsvaKJL93^p$Ds=TuJ_:v]6r\0241-7ZG2pm&BtMN]OP+πU"*d;.^,_+dr4&p)M?FHnq90V&pePijTTFxR>Zny[.)4MkST2?VxpB;FDn=QD7rFPπU">se3C4v4*HcUc&VZg.4Jl3.UVc1u:M(nR+*5HC:i$9]2&.\vF-DwD;l^2Y+7ToPπU"0]o=yg#Gv/27^4#sei*x5]186/92vBV#z]61<kiM3B%[$/YCIl\W7C_V::k5)9lπU"&0>%mh.7K5:^<5:_GQ8xx:N_kkdMith/p]y[13ToWfok*WdRD48D26$pQ24##$lπU"7Mmm+$FAIlnv0;oaU[KR3kpV9l+W=G;tq4o6l&M)uydEJF$,dBKyr<QVoN;'(DuπU"p%()9%%%%-%%X-6F&9a,e%G%%%&w%%%%0%%%(x(xn%sktS[ggxF*9p2%[U-j:L<πU"3v/%Aa8y.HmMUG;XZIp+k1K\Is<8&Iup(%)9%%#%-%o&'AFzhuL1s['%%4%:%%0πU"%%%%y%nrjq%tlSgRfx&f<X>SUU5OX$BqDs;<L/c5c$uE%BKIMPLkQOa%qzDH59*πU"9>dm.LYi8.[SO3ilja,l9roeTUbZ4<-*HR\_SLQ)UZKNa$jYLrM=g&sV5RaqlRGπU"+9]TIYpqGa3X%ZYRHPDV-<kqCc.SEG*APg:a5Z*]j'=9bV=?nV+r3TrU<dL7ftJπU"K4TN#R?Dtvp\X/=>&(]48,mkuLj+V.4WcH4b7t5f3SAPD:Ye)AAOQ++ZaQHGDH0πU"A?)A3*;((HZQA<QSRYLD<y^F[Vlj$krrtWJuw7rLN-R:%7,(,SF35q%68F735/_πU")/iD#aJR9OjMBu)#kn[TUZ9luf)k<Wj9OwF4r)EPM[vo=5)cH?[RFxAhz*&4o.sπU"c0je$D6gdhsIsr]X603Y<[3+yIU]F4^EAm0.XiEn3RHh5DjgA0(opF\46:,gfp#πU"=<*3?8NGXF)EohrxxWHtxp'Oq0KjS43E%.LqqGkgay>sF.N[OqHgNHC\?((Hxx:πU"$_\+,G)VYFK71V#5\B2VHa5l2*&pF;=\1Hxg7(xIy.>Yd++r.fx,#IyB(Yd,rBnπU"fxPBIyF0_y_U3h2y_Y1OsuQOD[_9a'kF'$Y9_j^F.ZSNV1dUko7$SZqSWy_pMe$πU"7;;ZQHtUb:B,#=vGF$0Z3W8Qji,za<#t=eE4D?>qK./GqY-g5T$Gf3>[5Yha+1:πU"WA>iZa1;V41Y-<N>SQDi7UAvXaeHZL1.G6qQ2.mXU_,2AW'Si6a[MO4[7K?m6[&πU"'+3=KB+S4m(C<2soBCT;Y['mrqY5)KA=ZSH+A$ZG[-m'tZ5/AhGZS1NAjZ[T3m1πU"Zu55AQqZS7AitZ[9dm=[5H;A][YS=A*.Q=Z*>0*YRU;[>QE)'=5IS\Cx5xD*QC=πU"Z*0**oRcTv#2UiMZOiXBgkqAwSv>38z&17bD>5%Qh51Rb>>?)'UhU*mMy1;f41)πU"^h>k>3i'Ul+UmsyL1n4k7S.x%%up()%9%%%7-%Sg##Fy-(,iI%%%%l%%%%0%%%%πU"yn%rjqt%lSggax\U)]IZULK.Y24M/3/5NY//1&O%kE/3'1qu9A9<*9YK+%%up(%πU")9%%%%-%S#&CFpB<DxE#'%%d%+%%/%%%%z%xjwt%sSgfCxLy,,>SU98Ll[d2+4bπU"ki/YM&)J'zz%&'io(hf)zSLY=:nr+4,mBVwvYKfi$A^STotBg27jc#Es?ua<w4wπU"*/Vh,B$n\J%6RTI5onefea?dfYR(h?87]=$bd#Q]$S4*>pfpk=b^^q0g,g'okcGπU"J4+vCp5twE_^$#$k9pn:,$'n4Nmd(H9;H'KK2yt',DA8j[yNde]gNJk1zx7<'flπU"8eZ(t6M\>7a9m70c7ipJ^3#c*,0NGUzd&Sfq\q+FmO/:Ot0#>v)M-$ScfInkTBgπU"5\Ei1EU_iF(p.u&+%N/oqz_d30$f)D2wZQ;xomrugNvWl[J^m*;XDTPqZ7cd]U,πU"=%U/GT,M?nd5,[K%mXdNxHHY1eChBo)^Eqr)R_5V?78Zj\Rf16Xth)49CKE?:5bπU",h[fJhc1<d#1m_Kw1)5.^HqpnPtvF.GRS9wYva\wA]LDu\,d=l'TwZS&PC+;S0PπU"KD_s78^6Sg_2f0X9e>%zMq8'XRiU&+SS$1OtC'\W6p\:wOeA.A[[A_YVVI,eO_SπU"-:8Z;PK^l/d0j.^CcpTdcw7CJfU59&z#&5k[\TG4v#^/2tH>3tT/lLXof8,TX0jπU"s+k6hk6KD>yxGfP?Ndq:NN$w<b.QuFNB0d4lFDp#8UE_n#SGb\.j*L(3eOTQm_^πU"yWh<$-AXWp;GBn/AsLrt*$uuzg4V2t'6dxcy-H?>H$2olB5^/P$>xa?a#3$=+cUπU"&o2)B^'130tH7J+TP^tYGx/BfXc,.[-J*6oLh$qAA7%ii?DUfOnj$J(khHrn9$EπU"YX1QoGRKa7-vWdu%p()9%%%%-+%Tg#UFx'),33%%+%O%%%%/%%%%zxj%wtsS#ggπU"x29iRKx=-GDTYNZ<G-km.[p+Ui)LH#;lh#NIU$wxZPFPwT4i_OxZe20m9rp1gxBπU"_HQ#BjLtF?#vb(OOcA6swt?9699hCu]h$bu$gcp$vUhpa,g(.sq?XsEQu)zIVUAπU"8[b.-tG.o4s]xVhlg6]=0t.E#%Y^P*E;NNF^s&Ela?wI#[LR'<P\pByn-x+de$nπU"jfcjfolYtQ3't4X;#TILUwDK2%,_u;Kbo7rrTj-o46(%%up&%'9%9%%%%-1%K'AπU"=F8bC)b6'%+%#-%%%1%%%%%%%%%&%E%%%%%%%%%q%fxyh%fqqS%gfxu%p&'9%%9πU"%%[%-%S[g#FXAR$(<[%%%e%%%%1%%%%%%%%%&%%E%%(%$'%%%qfx%yhfq%qSgg%πU"xup&%'9%9%%%%-1%s%A#F2O>%kZ&%(%A'%%%0%%%%%%%%%&%E%%%%M%(%%x&(xnπU"s%ktSg%fxup%&'9%%9%%%%-%X-.6F9a%,eG%.%%w%%%%0%%%%%%%%%&%%E%%%&UπU")%%(x(xn%sktS%ggxu%p&'9%%9%%#%-%o&'AFzhuL1s['%%4%:%%0%%%%%%%%%&πU"%%E%%+%J)%%%ynr%jqtl%Sgfx%up&'%9%9%%%%-%'Sg#FCy-,i%I%%%%l%%%%0%πU"%%%%%%%%&%E%7%%m,%%%yn%rjqt%lSgg%xup&%'9%9%%%%-%%S&C:Fp<D(xE'%(πU"%d+%%%/%%%%%%%%%&%E%%%%f%-%%z%xjwt%sSgf%xup&%'9%9%%%%-+%Tg#UFx'πU"),33%%+%O%%%%/%%%%%%%%%&%E[%%%X%/%%z%xjwt%sSgg%xup*%+%%%%%-%-+%πU"A&%+%:0%%%%%πEND SUBπCLOSE:IF S=194AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπEgbert Zijlema                 PB MOUSE IMPLEMENTATION        [e-mail]        08-14-96 (13:17)       PB                     923  27762    MOUSMENU.BAS' MOUSMENU.BAS    : shows how to implement the mouse in your programπ' Author          : Egbert Zijlema ([e-mail])π' (up)Date        : August 14, 1996π' Language        : Power Basic 3.2π' Copyright status: Public Domainπππ' Credit:π' The routines written in assembly (mouse driver calls & SUB Box)π' are from Dave Navarro. They came with Power Basic 3.2π' (MOUSUNIT.BAS & SCRNUNIT.BAS - subdirectory PB32\EXAMPLE).ππ' To improve the mouse driver stuff, 3 flags have been added:π' 1. mflg.allow - to be set on start up. Driver present.π' 2. mflg.mouse - driver activated by user (options menu).π' 3. mflg.mseon - (mouse on) to avoid switching on/off the cursor moreπ'    than once. This is rather crucial, due to the fact that the mouseπ'    is counting, not toggling, its on/off status.ππ' I also implemented a slight modification in SUB Box, making itπ' possible to choose 1 out of 3 rectangles: single frame, double frame,π' no frame (inverse or clean background)ππ$COMPILE EXE           ' compile the file if you might want to tryπ                       ' to exit to DOS (File-menu)πDEFINT A - Zππ%FALSE = 0 : %TRUE = NOT %FALSEππ' equates for arrow keys:π%HOME  = 71 * 256 : %UP  = 72 * 256 : %LEFT = 75 * 256π%RIGHT = 77 * 256 : %END = 79 * 256 : %DOWN = 80 * 256ππ' equates for command keysπ%TAB   = 9 : %ENTER = 13 : %ESCAPE = 27ππ' equates for pulldown menusπ%ALTI = 23 * 256                    ' open info menuπ%ALTO = 24 * 256                    ' open options menuπ%ALTF = 33 * 256                    ' open file menuπ%ALTX = 45 * 256                    ' exit programπ%F1   = 59 * 256                    ' help screenππTYPE GENERICFLAGSπ  mono AS INTEGER                   ' monochrome cardπ  menu AS INTEGER                   ' scroll menuπ  clok AS INTEGER                   ' time on/offπEND TYPEπDIM flag AS SHARED GENERICFLAGSππTYPE MOUSEFLAGSπ  allow AS INTEGER                  ' driver presentπ  mouse AS INTEGER                  ' driver activeπ  mseon AS INTEGER                  ' mouse cursor on/offπEND TYPEπDIM mflg AS SHARED MOUSEFLAGSππfilemenudata:π  DATA 4, 3π  DATA " *Select      "π  DATA " *Dos         "π  DATA " E*xit  Alt-X "ππinfomenudata:π  DATA 11, 3π  DATA " *Help     F1 "π  DATA " *Read Me     "π  DATA " *About       "ππhelpdata:π  DATA "HOT KEYS:"π  DATA "F1    : Display this helpscreen"π  DATA "Alt-x : Exit"π  DATA "Alt-f : Open File-menu"π  DATA "Alt-i : Open Info-menu"π  DATA "Alt-o : Open Options-menu"π  DATA ""π  DATA "Esc   : Cancel any operation"π  DATA "Tab   : Toggle yes/no in dialog box"ππaboutdata:π  DATA "MOUSE DEMO"π  DATA "Author: Egbert Zijlema"π  DATA "Status: Public Domain"ππreadmedata:π  DATA "MOUSE DIFFICULTIES"π  DATA "Routines concerning the mouse are basically very simple. They are"π  DATA "all done by calling INTERRUPT &H33. Depending of the value passed"π  DATA "through the AX-register, one can test for the presence of the"π  DATA "mouse, show/hide its cursor, define a screen area; and so on."π  DATA ""π  DATA "But unfortunately all those routines don't tell you how to"π  DATA "implement the mouse in your program. How, for instance, do you tell"π  DATA "your software that clicking the word  File  in the menu bar means"π  DATA "the same as pressing Alt-f (to pull down the File menu)?"π  DATA "This demo shows how to manipulate pull down menus and how to select"π  DATA "a file from a list of 30 filenames (out of an array of 60) - either"π  DATA "by the mouse or the arrow keys."ππDIM VideoAddress AS SHARED INTEGERπDIM MainScreen AS SHARED STRING                       ' initial screenπDIM FileName(1 : 60) AS SHARED STRINGππIF (pbvScrnCard AND 1) = 0 THENπ  VideoAddress = &HB800                               ' color cardπELSEπ  VideoAddress = &HB000                               ' monochromeπ  flag.mono = %TRUEπEND IFππIF MsThere THENπ  mflg.allow = %TRUE                                  ' mouse presentπ  mflg.mouse = %TRUE                                  ' mouse activeπ  DIM matrix(1 : 25, 1 : 80) AS SHARED INTEGER        ' screen matrixπEND IFππFUNCTION MsThere AS INTEGERπ  ! push DS                 ; save DS for PowerBASICπ  ! xor  AX, AX             ; clear AXπ  ! int  &H33               ; call mouse driverπ  ! xor  BX, BX             ; clear BX, assume no mouse presentππ  ! or   AX, AX             ; does AX = 0?π  ! jz   MsThereDone        ; yes, we're doneπ  ! dec  BX                 ; no, make it -1πMsThereDone:π  ! mov  FUNCTION, BX       ; put BX in RetVal variableπ  ! pop  DS                 ; restore DSπEND FUNCTIONππFUNCTION GetMouseOrKeyπ  STATIC t$                                            ' actual timeπ  MsStatus oldButn, oldRow, oldColπ  IF oldButn = 1 THEN oldKey = matrix(oldRow, oldCol)  ' avoid repeatingπ  DOππ    IF t$ <> TIME$ THENπ      t$ = TIME$π      IF flag.mono THEN COLOR 0, 7 ELSE COLOR 15, 7π      LOCATE 1, 72, 0π      IF flag.clok THEN PRINT t$ ELSE PRINT SPACE$(8)π    END IFππ    MsStatus buttons, row, colππ    IF INSTAT THENπ      FUNCTION = CVI( INKEY$ + CHR$(0) )π      EXIT FUNCTIONπ    ELSEIF (buttons = 1) AND ( matrix(row, col) <> oldKey ) THENπ      FUNCTION = matrix(row, col)π      EXIT FUNCTIONπ    ELSEIF buttons > 1 THEN                  ' right butn = Escapeπ      FUNCTION = %ESCAPEπ      EXIT FUNCTIONπ    END IFππ  LOOP UNTIL (oldButn = 1) AND (buttons = 0) ' until releasing left butnπ  FUNCTION = %ENTERπEND FUNCTIONππSUB WaitForInputπ  DOπ    MsStatus buttons, dummy, dummyπ  LOOP UNTIL LEN(INKEY$) OR buttonsπ  MsLocate 1, 1πEND SUBππSUB MsCursorOnπ  IF mflg.mouse = %FALSE THEN EXIT SUB            ' no mouse, so quitπ  IF mflg.mseon = %FALSE THEN                     ' only when mouse is offπ    ! push DS                  ; save DS for PowerBASICπ    ! mov  AX, 1               ; mouse driver function 1, turn on cursorπ    ! int  &H33                ; call driverπ    ! pop  DS                  ; restore DSπ    mflg.mseon = %TRUE                            ' mouse cursor onπ  END IFπEND SUBππSUB MsCursorOffπ  IF mflg.mouse = %FALSE THEN EXIT SUBπ  IF mflg.mseon THENπ    ! push DS                  ; save DS for PowerBASICπ    ! mov  AX, 2               ; mouse driver function 2, turn off cursorπ    ! int  &H33                ; call driverπ    ! pop  DS                  ; restore DSπ    mflg.mseon = %FALSE                           ' mouse cursor offπ  END IFπEND SUBππSUB MsLocate(BYVAL row AS INTEGER, BYVAL col AS INTEGER)π  IF mflg.mouse = %FALSE THEN EXIT SUBπ  IF (pbvScrnMode = 7) OR (pbvScrnMode = 0) THENπ    row = (row - 1) * 8π    col = (col - 1) * 8π  END IFππ  ! push DS                  ; save DS for PowerBASICπ  ! mov  AX, &H04            ; function 04h, set mouse locationπ  ! mov  CX, col             ; put column in CXπ  ! mov  DX, row             ; put row in DXπ  ! int  &H33                ; call mouse interruptπ  ! pop  DS                  ; restore DS for PowerBASICπEND SUBππSUB MsStatus(buttons AS INTEGER, row AS INTEGER, col AS INTEGER)π  IF mflg.mouse = %FALSE THEN EXIT SUBπ  ! push DS                  ; save DS for PowerBASICπ  ! mov  AX, &H03            ; function 03h, get mouse statusπ  ! int  &H33                ; call mouse interruptπ  ! les  DI, buttons         ; point ES:DI to buttonsπ  ! mov  ES:[DI], BX         ; put active button(s) in variableπ  ! les  DI, row             ; point ES:DI to Rowπ  ! mov  ES:[DI], DX         ; put mouse row in variableπ  ! les  DI, col             ; point ES:DI to Columnπ  ! mov  ES:[DI], CX         ; put mouse column in variableπ  ! pop  DS                  ; restore DS for PowerBASICππ  IF (pbvScrnMode = 7) OR (pbvScrnMode = 0) THENπ    row = (row \ 8) + 1      ' if text mode, then fix coordinatesπ    col = (col \ 8) + 1π  END IFπEND SUBππSUB MsSetWindow(BYVAL Row  AS INTEGER, BYVAL Col  AS INTEGER, _π                BYVAL Rows AS INTEGER, BYVAL Cols AS INTEGER)ππ  IF mflg.mouse = %FALSE THEN EXIT SUBπ  Rows = Row + Rows - 1      ' adjust rows to real coordinatesπ  Cols = Col + Cols - 1      ' adjust cols to real coordinatesππ  IF (pbvScrnMode = 7) OR (pbvScrnMode = 0) THENπ    Row  = Row  * 8          ' if text mode, adjust coordinatesπ    Rows = Rows * 8π    Col  = Col  * 8π    Cols = Cols * 8π  END IFππ  ! push DS                  ; save DS for PowerBASICπ  ! mov  CX, Row             ; put start row in CXπ  ! mov  DX, Rows            ; put end row in DXπ  ! mov  AX, &H08            ; function 08h, set vertical limitπ  ! int  &H33                ; call mouse interruptπ  ! mov  CX, Col             ; put start column in CXπ  ! mov  DX, Cols            ; put end column in DXπ  ! mov  AX, &H07            ; function 07h, set horizontal limitπ  ! int  &H33                ; call mouse interruptπ  ! pop  DS                  ; restore DS for PowerBASICπEND SUBππSUB Box(BYVAL Row AS INTEGER, BYVAL Col AS INTEGER, BYVAL Rows AS INTEGER, _π        BYVAL Cols AS INTEGER, BYVAL Shape AS INTEGER, BYVAL Attr AS BYTE)ππ  ' draw a rectangleπ  ' original from Power Basic Inc.π  ' modified by Egbert Zylema (NL)ππ  SELECT CASE Shapeππ    CASE 1ππ      ' draw single rectangleπ      TL.Char? = 218            ' ┌π      TR.Char? = 191            ' ┐π      BL.Char? = 192            ' └π      BR.Char? = 217            ' ┘π      Hor?     = 196            ' ─π      Vert?    = 179            ' │ππ    CASE 2ππ      ' draw double rectangleπ      TL.Char? = 201            ' ╔π      TR.Char? = 187            ' ╗π      BL.Char? = 200            ' ╚π      BR.Char? = 188            ' ╝π      Hor?     = 205            ' ═π      Vert?    = 186            ' ║ππ    CASE 0ππ      ' background without frameπ      ' cleans the area when attri is set to zeroπ      TL.Char? = 32π      TR.Char? = 32π      BL.Char? = 32π      BR.Char? = 32π      Hor?     = 32π      Vert?    = 32π  END SELECTππ  ! push DS                 ; save DSππ  ! mov  AX, VideoAddress   ; put screen segment in AXπ  ! mov  ES, AX             ;  and in ESππ  ! mov  AX, Row            ; put row in AXπ  ! dec  AX                 ; minus oneπ  ! mov  CX, 160            ; AX =π  ! mul  CX                 ;   AX * 160π  ! mov  DI, AX             ; put it in DIπ  ! mov  AX, Col            ; put column in AXπ  ! dec  AX                 ; minus oneπ  ! shl  AX, 1              ; times 2π  ! add  DI, AX             ; add to DIππ  ! mov  DX, Rows           ; put rows in DXπ  ! dec  DX                 ; minus top rowπ  ! dec  DX                 ; minus bottom rowππ  ! mov  CX, Cols           ; put columns in CXπ  ! dec  CX                 ; minus left columnπ  ! dec  CX                 ; minus right columnππ  ! mov  AH, Attr           ; put attribute in AHππ  ! push CX                 ; save CX (columns)π  ! push DI                 ;  and DI (screen location)π  ! mov  AL, TL.Char?       ; put top left char in ALπ  ! stosw                   ; write it to the screenπ  ! mov  AL, Hor?           ; put top char in ALπ  ! rep  stosw              ; write it to the screen CX timesπ  ! mov  AL, TR.Char?       ; put top right char in ALπ  ! stosw                   ; write it to the screenπ  ! pop  DI                 ; restore DIπ  ! pop  CX                 ;  and CXππHorizLoop:π  ! add  DI, 160            ; move to next row on the screenπ  ! push CX                 ; save CXπ  ! push DI                 ;  and DIπ  ! mov  AL, Vert?          ; put left char in ALπ  ! stosw                   ; write it to the screenπ  ! mov  AL, 32             ; put a space in ALπ  ! rep  stosw              ; write it to the screen CX timesπ  ! mov  AL, Vert?          ; put right char in ALπ  ! stosw                   ; write it to the screenπ  ! pop  DI                 ; restore DIπ  ! pop  CX                 ;  and CXπ  ! dec  DX                 ; one less rowπ  ! jnz  HorizLoop          ; loop until DX (rows) = 0ππ  ! add  DI, 160            ; move to next row on the screenπ  ! mov  AL, BL.Char?       ; put bottom left char in ALπ  ! stosw                   ; write it to the screenπ  ! mov  AL, Hor?           ; put bottom char in ALπ  ! rep  stosw              ; write it to the screen CX timesπ  ! mov  AL, BR.Char?       ; put bottom right char in ALπ  ! stosw                   ; write it to the screenππ  ! pop  DS                 ; restore DS for PowerBASICπEND SUBππSUB repaint(row, col, attri, length)π  start  = (row - 1) * 160 + (col - 1) * 2π  finish = start + (length - 1) * 2π  DEF SEG = VideoAddressπ  FOR offset = start TO finish STEP 2π    POKE offset + 1, attri                     ' color offsetπ  NEXTπ  DEF SEGπEND SUBππFUNCTION YesNo(header$)π  MsCursorOffπ  IF flag.mono THEN attri = 15 ELSE attri = 63π  question$ = "Are you sure?"π  IF LEN(question$) < LEN(header$) THENπ    length = LEN(header$)π  ELSEπ    length = LEN(question$)π  END IFπ  col = (80 - length) \ 2π  Box 10, col - 2, 7, length + 4, 2, attriπ  Box 13, 33, 3, 13, 1, attriπ  COLOR attri MOD 16, attri \ 16π  LOCATE 11, col : PRINT header$π  LOCATE 12, col : PRINT "Are you sure?"π  LOCATE 13, 39  : PRINT CHR$(194)                     ' ┬π  LOCATE 14, 34  : PRINT " Yes ";CHR$(179);" No  "     ' │π  LOCATE 15, 39  : PRINT CHR$(193)                     ' ┴π  IF flag.mono THENπ    repaint 14, 36,  7, 3         ' normal white (initials are intense)π    repaint 14, 42,  7, 1π  ELSEπ    repaint 14, 35, 62, 1         ' initials yellow on cyaneπ    repaint 14, 41, 62, 1π  END IFπ  DEF SEG = VideoAddressπ  YesNoScrn$ = PEEK$(160, 3840)π  DEF SEGππ  init = %TRUE : result = %FALSEπ  ERASE matrixπ  FOR cell = 34 TO 38π    matrix(14, cell) = ASC("Y")π  NEXTπ  FOR cell = 40 TO 44π    matrix(14, cell) = ASC("N")π  NEXTπ  MsSetWindow 12, col - 2, 2, length + 2π  DOπ    MsCursorOnπ    IF init THENπ      init = %FALSEπ      KeyIn = %TABπ    ELSEπ      KeyIn = GetMouseOrKeyπ    END IFπ    SELECT CASE KeyInπ      CASE ASC("Y"), ASC("y")π        result = %TRUEπ        KeyIn = %ENTERπ      CASE ASC("N"), ASC("n"), %ESCAPEπ        result = %FALSEπ        KeyIn = %ENTERπ      CASE %TABπ        IF result THENπ          result = %FALSE : offset = 40π        ELSEπ          result = %TRUE  : offset = 34π        END IFπ    END SELECTπ    MsCursorOffπ    DEF SEG = VideoAddressπ    POKE$ 160, YesNoScrn$π    DEF SEGπ    repaint 14, offset, 15, 5π    IF flag.mono THENπ      repaint 14, offset, 112, 5         ' inverseπ    ELSEπ      repaint 14, offset + 1, 14, 1      ' yellowπ    END IFπ  LOOP UNTIL KeyIn = %ENTERπ  FUNCTION = resultπ  MainMatrixπEND FUNCTIONππ' ............... end of library routines ........................ππSUB MainMatrixπ  ERASE matrixπ  CALL MenuBarMatrixπ  row = 3 : col = 4π  FOR count = 1 TO 30                              ' 30 files displayedπ    FOR cell = col TO col + 11                     ' length = 12π      matrix(row, cell) = count + 256              ' no ASCII valuesπ    NEXTπ    INCR col, 14π    IF col = 74 THENπ      INCR row : col = 4π    END IFπ  NEXTππ  FOR cell = 1 TO 80                               ' mouse out of boundsπ    matrix(2, cell) = %UP                          ' to simulate up &π    matrix(9, cell) = %DOWN                        ' down arrowπ  NEXTπEND SUBππSUB MenuBarMatrixπ  FOR cell = 5 TO 8π    matrix(1, cell)     = %ALTFπ    matrix(1, cell + 7) = %ALTIπ  NEXTπ  FOR cell = 19 TO 25π    matrix(1, cell)     = %ALTOπ  NEXTπEND SUBππSUB DrawMenuBarπ  SHARED bar$π  COLOR 0, 7π  LOCATE 1, 1 : PRINT SPACE$(80);π  LOCATE 1, 5 : PRINT "File   Info   Options"π  IF flag.mono = %FALSE THENπ    repaint 1,  5, 116, 1π    repaint 1, 12, 116, 1π    repaint 1, 19, 116, 1π  END IFπ  DEF SEG = VideoAddressπ  bar$ = PEEK$(0, 50)π  DEF SEGπEND SUBππSUB DrawMainScreenπ  shape = 2                                          ' double frameπ  attri = 15                                         ' intense whiteπ  start = 1                                          ' record to start withπ  total = 30                                         ' 30 recordsπ  Box 2, 1, 20, 80, shape, attri                     ' draw rectangleππ  CollectFileNamesπ  DisplayFiles start, totalππ  DEF SEG = VideoAddressπ  MainScreen = PEEK$(160, 3840)                      ' exclude menubarπ  DEF SEGπ  COLOR 7,0π  LOCATE 25, 4π  PRINT "Press F1 for help";πEND SUBππSUB CollectFileNamesπ  FileToFind$ = DIR$("C:\DOS\*.*")π  DO WHILE LEN(FileToFind$)π    INCR countπ    FileName(count) = FileToFind$ + SPACE$(12 - LEN(FileToFind$))π    IF count = UBOUND(FileName) THEN EXIT DO         ' don't exceed 60π    FileToFind$ = DIR$π  LOOPπ  ARRAY SORT FileName()                              ' alfabetic orderπEND SUBππSUB DisplayFiles(start, total)π  COLOR 15, 0π  row = 3 : col = 4π  FOR count = start TO start + total - 1π    LOCATE row, colπ    PRINT FileName(count)π    INCR col, 14π    IF col = 74 THENπ      INCR row : col = 4π    END IFπ  NEXTπEND SUBππSUB DosEscapeπ  IF BIT(pbvHost, 5) <> 0 THEN EXIT SUB     ' don't try this in the IDEπ  DefaultDir$ = CURDIR$π  DEF SEG = VideoAddressπ  OldScreen$ = PEEK$(0, 4000)π  COLOR 7, 0π  CLSπ  LOCATE 1, 1π  PRINT "Type EXIT and press ENTER to return..."π  SHELLππ  ' restore drive and directoryπ  IF LEFT$(CURDIR$, 2) <> LEFT$(DefaultDir$, 2) THENπ    CHDRIVE LEFT$(DefaultDir$, 2)π  END IFπ  IF CURDIR$ <> DefaultDir$ THEN CHDIR DefaultDir$π  POKE$ 0, OldScreen$π  DEF SEGπEND SUBππSUB ShowTextπ  IF flag.mono THEN attri = 112 ELSE attri = 94π  Box 5, 5, 15, 69, 0, attriπ  COLOR attri MOD 16, attri \ 16π  RESTORE readmedataπ  FOR count = 1 TO 13π    READ me$π    LOCATE count + 5, 6 : PRINT me$π  NEXTπ  LOCATE 14, 43 : PRINT CHR$(34)π  LOCATE 14, 48 : PRINT CHR$(34)π  WaitForInputπEND SUBππSUB Aboutπ  IF flag.mono THEN attri = 112 ELSE attri = 78π  Box 3, 10, 5, 26, 1, attriπ  COLOR attri MOD 16, attri \ 16π  RESTORE aboutdataπ  FOR count = 1 TO 3π    READ abt$π    LOCATE count + 3, 12 : PRINT abt$π  NEXTπ  WaitForInputπEND SUBππSUB HelpTextπ  IF flag.mono THEN attri = 112 ELSE attri = 31π  Box 3, 10, 11, 39, 1, attriπ  COLOR attri MOD 16, attri \ 16π  RESTORE helpdataπ  FOR count = 1 TO 9π    READ help$π    LOCATE count + 3, 12 : PRINT help$π    IF flag.mono = %FALSE AND count > 1 THENπ      repaint count + 3, 12, 30, 5                  ' yellow on blueπ    END IFπ  NEXTπ  WaitForInputπEND SUBππSUB DrawMenu(menu$(), options, column, length, letter$)π  shape = 1π  flag.menu = %TRUEπ  IF flag.mono THEN attri = 112 ELSE attri = 127π  rows = UBOUND(menu$) + 2π  cols = LEN(menu$(1)) + 1                          ' + 2 - 1 (asterix)π  MsSetWindow 0, 0, options + 2, 28π  ERASE matrixπ  MenuBarMatrixπ  MsCursorOffπ  repaint 1, column + 1, 12, 1π  repaint 1, column + 2,  7, length - 1π  Box 2, column - 1, rows, cols, shape, attriπ  COLOR attri MOD 16, attri \ 16π  FOR count = 1 TO UBOUND(menu$)π    split    = INSTR(menu$(count), "*")π    PartTwo$ = MID$(menu$(count), split + 1)π    letter$  = letter$ + UCASE$(LEFT$( PartTwo$, 1) )π    offset   = column + split - 1π    LOCATE count + 2, columnπ    PRINT LEFT$(menu$(count), split - 1) + partTwo$ππ    IF flag.mono = %FALSE THENπ      repaint count + 2, offset, attri + 4 - attri MOD 16, 1  ' redπ    END IFππ    FOR cell = column TO column + cols - 3π      matrix(count + 2, cell) = count + 256π    NEXTπ  NEXTπEND SUBππSUB FileMenu(choice)π  RESTORE filemenudataπ  READ column, optionsπ  REDIM MenuItem(1 : options) AS LOCAL STRINGπ  FOR count = 1 TO optionsπ    READ MenuItem(count)π  NEXTπ  length = 4π  DrawMenu MenuItem(), options, column, length, letter$π  InRow = 1                                        ' 1 per rowπ  exclude = %ALTFπ  length = LEN( MenuItem(1) ) - 1                  ' minus asterixπ  ScrollMenu letter$, options, InRow, column, exclude, length, resultπ  SELECT CASE resultπ    CASE 1π      ScreenMenuπ    CASE 2π      MsCursorOffπ      DosEscapeπ    CASE 3π      ' return result to main menu to avoid recursionπ      choice = %ALTXπ    CASE %LEFT, %ALTOπ      choice = %ALTOπ    CASE %RIGHT, %ALTIπ      choice = %ALTIπ  END SELECTπEND SUBππSUB InfoMenu(choice)π  RESTORE infomenudataπ  READ column, optionsπ  REDIM MenuItem(1 : options) AS LOCAL STRINGπ  FOR count = 1 TO optionsπ    READ MenuItem(count)π  NEXTπ  length = 4π  DrawMenu MenuItem(), options, column, length, letter$π  InRow = 1                                        ' 1 per rowπ  exclude = %ALTIπ  length = LEN( MenuItem(1) ) - 1                  ' minus asterixπ  ScrollMenu letter$, options, InRow, column, exclude, length, resultπ  SELECT CASE resultπ    CASE 1π      choice = %F1π    CASE 2π      MsCursorOffπ      ShowTextπ    CASE 3π      MsCursorOffπ      Aboutπ    CASE %RIGHT, %ALTOπ      choice = %ALTOπ    CASE %LEFT, %ALTFπ      choice = %ALTFπ  END SELECTπEND SUBππSUB OptionsMenu(choice)π  IF mflg.allow THEN options = 2 ELSE options = 1π  REDIM MenuItem(1 : options) AS LOCAL STRINGππ  IF flag.clok THEN extra$ = "ff " ELSE extra$ = "n  "π  MenuItem(1) = " *Time  o" + extra$π  IF options = 2 THENπ    IF mflg.mouse THEN plus$ = "ff " ELSE plus$ = "n  "π    MenuItem(2) = " *Mouse o" + plus$π  END IFπ  column = 18π  length = 7π  DrawMenu MenuItem(), options, column, length, letter$π  InRow = 1π  exclude = %ALTOπ  length = LEN( MenuItem(1) ) - 1                  ' minus asterixπ  ScrollMenu letter$, options, InRow, column, exclude, length, resultπ  question$ = "Time to be switched off!"π  SELECT CASE resultπ    CASE 1π      IF flag.clok THENπ        IF YesNo(question$) THEN flag.clok = %FALSEπ      ELSEπ        flag.clok = %TRUEπ      END IFπ    CASE 2π      IF mflg.allow = %FALSE THEN EXIT SELECTπ      IF mflg.mouse THEN mflg.mouse = %FALSE ELSE mflg.mouse = %TRUEπ      MsLocate 1, 1π    CASE %LEFT, %ALTIπ      choice = %ALTIπ    CASE %RIGHT, %ALTFπ      choice = %ALTFπ  END SELECTπEND SUBππSUB ScreenMenuπ  STATIC FirstChar$π  MainMatrixπ  IF FirstChar$ = "" THENπ    FOR count = 1 TO UBOUND(FileName)π      FirstChar$ = FirstChar$ + LEFT$(FileName(count), 1)π    NEXTπ  END IFπ  options = UBOUND(FileName)π  InRow = 5π  column = 4π  exclude = 0π  length = LEN( FileName(1) )π  MsSetWindow 0, 0, 9, 80π  ScrollMenu FirstChar$, options, InRow, column, exclude, length, resultπ  MsCursorOffπ  COLOR 15, 0π  LOCATE 20, 4 : PRINT "You selected ";π  IF result THENπ    PRINT FileName(result);π    COLOR 7π    LOCATE 25, 4 : PRINT "Press any key or click mouse button";π    WaitForInputπ  END IFπEND SUBππSUB ScrollMenu(letter$, options, InRow, column, exclude, length, result)π  SHARED bar$                                   ' see: DrawMenuBarππ  ' LEGEND:π  ' letter$ = marked characters of menu optionsπ  ' options = number of array elementsπ  ' InRow   = elements per rowπ  ' column  = first columnπ  ' exclude = value of the key that opened the menuπ  ' length  = length of each elementππ  first = 1                                     ' first element main screenπ  IF flag.menu THEN                             ' menu scrollingπ    total   = options                           ' all options on screenπ    between = 0                                 ' no spacesπ  ELSE                                          ' screen scrollingπ    init = %TRUEπ    total   = 30                                ' 30 filenamesπ    between = 2                                 ' 2 spaces in betweenπ  END IFππ  DEF SEG = VideoAddressπ    MenuScrn$ = PEEK$(160, 3840)                ' initial screenπ  DEF SEGπ  MsCursorOnππ  DOπ    IF init THENπ      init = %FALSEπ      action = %RIGHTπ    ELSEπ      action = GetMouseOrKeyπ    END IFπ    SELECT CASE actionπ      CASE %ESCAPEπ        result = 0π        EXIT DOπ      CASE 65 TO 90, 97 TO 122π        match = INSTR( letter$, UCASE$(CHR$(action)) )π        IF match THENπ          result = matchπ          IF flag.menu THEN EXIT DOπ        END IFπ      CASE %LEFT, %RIGHTπ        IF flag.menu THENπ          result = actionπ          EXIT DOπ        ELSEπ          CALL LeftRight(action, result, options)π        END IFπ      CASE %UP, %DOWNπ        MsStatus buttons, row, colπ        UpDown action, row, InRow, options, result, cursorπ        IF (buttons = 1) AND (cursor > 2) THEN MsLocate cursor, colπ      CASE %HOME, %ENDπ        IF action = %HOME THEN result = 1 ELSE result = optionsπ      CASE 257 TO total + 256π        result = action + first - 257π      CASE %ALTF, %ALTI, %ALTOπ        IF flag.menu = %FALSE THEN EXIT SELECTπ        IF action = exclude THEN result = 0 ELSE result = actionπ        IF result THEN EXIT DOπ    END SELECTπ    MsCursorOffππ    ' do we need to refresh the main screen?π    IF flag.menu = %FALSE THENπ      IF refresh(result, first, total, InRow) THENπ        DisplayFiles first, totalπ        DEF SEG = VideoAddressπ        MenuScrn$ = PEEK$(160, 3840)π        DEF SEGπ      END IFπ    END IFππ    DEF SEG = VideoAddressπ    POKE$ 160, MenuScrn$π    DEF SEGππ    IF result THENπ      row = (result - first) \ InRow : INCR row, 3π      col = ( (result - first) MOD InRow ) * (length + between)π      INCR col, columnπ      IF flag.menu THEN attri = 7 ELSE attri = 112π      repaint row, col, attri, lengthπ    END IFπ    MsCursorOnπ  LOOP UNTIL action = %ENTERπ  MsCursorOffπ  IF flag.menu THENπ    DEF SEG = VideoAddressπ    POKE$ 0, bar$π    POKE$ 160, MainScreenπ    DEF SEGπ    flag.menu = %FALSEπ  END IFπEND SUBππSUB LeftRight(action, result, options)π  SELECT CASE actionπ    CASE %LEFT  : IF result > 1 THEN DECR resultπ    CASE %RIGHT : IF result < options THEN INCR resultπ  END SELECTπEND SUBππSUB UpDown(action, row, InRow, options, result, cursor)π  old = resultπ  SELECT CASE actionπ    CASE %UPπ      DECR result, InRowπ      cursor = row + 1π    CASE %DOWNπ      INCR result, InRowπ      cursor = row - 1π  END SELECTπ  SELECT CASE resultπ    CASE < 1π      IF flag.menu THEN result = options ELSE result = oldπ    CASE > optionsπ      IF flag.menu THEN result = 1 ELSE result = oldπ  END SELECTπEND SUBππFUNCTION refresh(result, first, total, InRow)π  SELECT CASE resultπ    CASE 0π      FUNCTION = %FALSEπ      EXIT FUNCTIONπ    CASE => first + totalπ      DO WHILE result => first + totalπ        INCR first, InRowπ      LOOPπ      FUNCTION = %TRUEπ    CASE < firstπ      DO WHILE result < firstπ        DECR first, InRowπ      LOOPπ      FUNCTION = %TRUEπ    CASE ELSEπ      FUNCTION = %FALSEπ  END SELECTπEND FUNCTIONππSUB MainMenuπ  DOπ    IF choice THENπ      KeyIn = choiceπ      choice = 0π    ELSEπ      KeyIn = GetMouseOrKeyπ    END IFπ    SELECT CASE KeyInπ      CASE %ALTXπ        IF YesNo("Quitting demo") THENπ          MsCursorOffπ          COLOR 7, 0π          CLSπ          SYSTEMπ        END IFπ      CASE %F1   : Helptextπ      CASE %ALTI : InfoMenu choiceπ      CASE %ALTF : FileMenu choiceπ      CASE %ALTO : OptionsMenu choiceπ    END SELECTπ    MsCursorOffπ    DEF SEG = VideoAddressπ    POKE$ 160, MainScreenπ    DEF SEGπ    MsSetWindow 0, 0, 25, 80π    MsCursorOnπ  LOOPπEND SUBππ' sample mainπCLSπ  flag.clok = %TRUE         ' time onπ  DrawMenuBarπ  DrawMainScreenπ  MainMatrixπ  MsLocate 1, 1π  MsCursorOnπ  MainMenuπENDπEgbert Zijlema                 SPLIT SCREEN COLOR ATTRIBUTE   [e-mail]        08-05-96 (16:52)       PB                     77   1828     SPLITCLR.BAS' SPLITCLR.BAS    - splits the screen color attribute in fore- and backgroundπ'                   the demo shows 2 methods, use the 1 you preferππ' Author          : Egbert Zijlema ([e-mail])π' Date            : August 5, 1996π' Copyright status: Public DomainππDEFINT A-ZππCLSπ  row = 10π  col = 10π  text$ = " Egbert"π  COLOR 14, 4         ' yellow on redπ  LOCATE row, colπ  PRINT text$ππ  ' show result on next row (after 2 seconds)π  SLEEP 2π  FOR action = 1 TO LEN(text$)π    SplitColor row, col, character$, fore, backπ    LOCATE row + 1, colπ    COLOR fore, backπ    PRINT character$π    INCR colπ    DELAY .1               ' just for the demoπ  NEXTππ  COLOR 7, 0π  LOCATE 25, 1π  PRINT "Press any key to proceed";π  DOπ  LOOP UNTIL LEN(INKEY$)π  LOCATE 25, 1π  PRINT SPACE$(80);ππ  ' now let's use the video segmentπ  VidSeg = &HB800     ' assume color cardπ  row = 10π  text$ = " Zijlema "π  COLOR 14, 4π  LOCATE row, colπ  PRINT text$ππ  DELAY 2π  FOR action = 1 TO LEN(text$)π    CALL ColorSplit(row, col, character, attri)π    offset = row * 160 + (col - 1) * 2      ' next row!π    DEF SEG = VidSegπ    POKE offset, characterπ    POKE offset + 1, attriπ    DEF SEGπ    INCR colπ    DELAY .1π  NEXTπ  COLOR 7, 0            ' restore defaultπ  LOCATE 10, 10: PRINT SPACE$(16);πENDππSUB SplitColor (row, col, character$, fore, back)π  ' using POWER BASIC's SCREEN functionπ  char = SCREEN(row, col)π  character$ = CHR$(char)π  attri = SCREEN(row, col, 1)π  fore = attri MOD 16π  back = attri \ 16πEND SUBππSUB ColorSplit (row, col, character, attri)π  ' using video segmentπ  SHARED VidSegπ  DEF SEG = VidSegπ  offset = (row - 1) * 160 + (col - 1) * 2π  character = PEEK(offset)π  attri = PEEK(offset + 1)π  DEF SEGπEND SUBπJohn Fischer                   HAPPY BIRTHDAY SONG            FidoNet QUIK_BAS Echo          07-10-96 (23:52)       QB, QBasic, PDS        7    274      HAPBIRTH.BAS' > I was wondering if you could give some source code for Qbasic thatπ' > will play "happy birthday"...ππ'Happy Birthday to YouπPLAY "MNT150L8O4CCL4DCFL2EL8CCL4DCGL2FL8CCL4>C<AFEL2DL8A+A+"πPLAY "L4AFGL2FL8CCL4DCFL2EL8CCL4DCGL2FL8CCL4>C<AFEL2DL8A+A+"πPLAY "L4AFGL2F"πJohn Fischer                   MORE THEME SONGS               FidoNet QUIK_BAS Echo          07-14-96 (00:47)       QB, QBasic, PDS        61   3127     THEMES.BAS  ' > Do any of you know how to play QUICKBASIC music in the background of aπ' > program?ππ'I believe that MB in the play statement switches it to BACKGROUND and MFπ'switches it to FOREGROUND playing.  Check out your HELP on PLAY.ππ' > Also, do any of you got any good QUICKBASIC music with the PLAYπ' > command, (Like the Happy Birthday thing I saw)ππREM The Adaams Family Movie ThemeπPLAY "MNT200L8O3CDEFP4L4FP8FP8L8DEF+GP4L4O1GP8GP8L8O3DEF+GP4"πPLAY "DEF+GP4CDEFP4L4O1FP8FP8P4L8O3CF.AF.D<A+.>GP4FE.GE.C<A."πPLAY ">FP4CF.AF.D<A+.>GP4FL64EFL8E.CD.EFP4CDEFP4L4FP8FP8L8D"πPLAY "EF+GP4L4O1GP8GP8L8O3DEF+GP4DEF+GP4CDEFP4L4O1FP8FP8P4L8O3C"πPLAY "F.AF.D<A+.>GP4FE.GE.C<A.>FP4CF.AF.D<A+.>GP4FL64EFL8E."πPLAY "CD.EFP4"ππREM Flash Dance ThemeπPLAY "MNT150L2O3E.L8DCL2D.L8DEL2F.L8EEEDL2CL8DCL2A.L8GFL2G."πPLAY "L8FGFEL2DL4CL2D.L8CDL2E.L8DCL2D.L8DEL2F.L8EEEDL4CP4L8D"πPLAY "CL2A.L8GFL2G.L8FGFEL4DL8>DCL4CL8DDL2D.P4L4CL8CCP4DDL4D"πPLAY "P4L8<CDL2E.L8DCL4DL2<GL8>DDL2F.L8EDEDL2CL8DCL2A.L8>C<A"πPLAY "L2G.L8FEFEL4DL8>DCL4CP4CDP8L8<GBL4>CCL8C<BL4BL8BAL4AG"πPLAY "L8GBL4>CCL8C<BL4BL8BAL4AGL8GB>CL4CDL8CL4<BL8>CL4C.L8D"πPLAY "L4<GG.P4L8GB>CCL4<AL8>C<BL4BL8BAAAL4>DCL8CCL4<AL8>C<B"πPLAY "L4BL8BAL4AL8GB>CL4C.L8DCL4<BL8>CL4C.L8D<GL4GG>C<BL8BB"πPLAY "AAL4AGL8GBL4>CCL8C<BL4BL8BAL4AGL8GBL4>CCL8C<BL4BL8BAL4A"πPLAY "GL8GBL4>CCL8C<BL4BL8BAL4AGL8GBL1C"ππREM Ave MariaπPLAY "MLT100L16O1A+.>D.F.<A+.>D.F.<A+.>D.F.<A+.>D.F.A+.D.F.<A+.>D.F.<A+.>"πPLAY "D.E.A.D.A+.>D.<D.F.<F.A+.>D.<F.A.>D+.<F.A.O3C.<A+.<A+.>D.<G.A+.>D.<"πPLAY "G.A+.>D.<G.A+.>D.>C.O1G.>C.<D+.G.>C.>DC<A+.C.A.G.C.A.A+.D.F.<A+.>D."πPLAY "F.<A+.>D.F.>D.<D.F.<A+.>D.F+.<A+.O3C.<A+.A.D.G.>D.<D.>E.D.<D.E.<A+."πPLAY ">D.E.>C+.<C+.G.<A.>C+.A.>C.<D+.F+.<A.>D+.A+.A.>C.D.D+.C.<A.A+.D.G.<"πPLAY "A+.>D.G.<A+.>D.E.>D.<D.>C.O1A.>C.F.<A.>C.A.G.B.>D.F.D.<B.>C.<C.F.<A.>"πPLAY "C.F.<A+.>G.A.A+.A.G.F.C.F.<A.>C.F.<A.>C.F.P64F.C.F.>C.O1A.>D+.<F.A."πPLAY "O3C.P64C.O1A.>B.>C.O1A.O3D.C.O1A+.O3D.<A+.<A+.>D.<F.A+.>D.<F.A+.>A+."πPLAY ">C.O1A.>D+.<F.A.O3C.P64C.<B.>C.D+.D.C.<A+.<A+.>D.<G.A+.>D.<G.A+.>D.A+.<"πPLAY "A+.>D.>C.O1A.>C.<F.A.O3C.D.O1A.O3D.P64D.D+.D.C.D.F.<C.D+.>D+.<C.D+.<G."πPLAY ">C.D+.G.C.D+.>D.O1G.>C.>C.O1G.O3C.<A+.A.A+.>C+.C.<A+.>C.O1A.>C.<F.A.>"πPLAY "C.<F.A.>D+.<F.A.>D+.A+.D.F.<A+.>D.F.<A+.>D.E.A.D.A+.>D.O1A+.>D.<F.A+.>"πPLAY "D.<F.A.>D+.<F.A.O3C.<A+.D.F.<A+.>D.F.>D.<D.F.>F.<D.F.L2>A+P4"ππREM Star Trek TOS ThemeπPLAY "MNT255L1O4B.D.F.<A.P8L2GL8G>C.L2FFL4E.L8EL4C<A>DL2GP8"πPLAY "L4GL1BP4L2CL8CF.L2A+A+L4A.L8AL4FDGL2>CP8L4CL1EP1L2O3G"πPLAY ">F.L4EDC<BL2A+L1A+L2G>G.L4FEDCL2<BL1BL4A+L2A.L4B>C+DE"πPLAY "F+GL2AL1A+.L2<A+.L4>CDD+FGG+L2A+L1BL2<G>F.L4EDC<BL2A+"πPLAY "L1A+L4G+L2G>G.L4FEDCL2<BL1BL4A+L2A.L4B>CDEFEL2G.L4GL2A+."πPLAY "L4AL2GL1CL4D.F.A.L1>C"ππ'I hope these are the type of thing you are looking for.  If you want toπ'test out the background command, just add:ππ'PLAY "MB"   'before the song andπ'PLAY "MF"   'after the song.ππ'I have MANY more of these if you are interested.  I didn't write them andπ'have absolutely NO idea who did.  I had them in an old ZIP file on archiveπ'and it doesn't contain any credits in it.πCharles Godard                 FLUTE BOOK MUSIC COLLECTION    FidoNet QUIK_BAS Echo          07-16-96 (00:05)       QB, QBasic, PDS        39   2055     FLUTEMUS.BAS'  >Do any of you know how to play QUICKBASIC music in the background of aπ'  >program?ππ'I never could figure out how to play more than about 32 notes in theπ'background (the best I can remember).  Had to keep looping back everπ'so often to keep it playing in bg... the MB command does it.ππ'  >Also, do any of you got any good QUICKBASIC music with the PLAY command,π'  >(Like the Happy Birthday thing I saw)ππ'I copied these from a flute book, and played with the tempo, octaves,etc.ππREM ABC SONG:πPLAY "O3 l4ccggaal2g l4ffeel8ddddl2c l4ggffee l2dl8ggl4gffeel2d l4ccggaal2g l4ffee l4dd l2c"ππREM BINGO:π  PLAY "mb O3 L8GGDDEEDDGGAAL4BGBBL8>CCL4C<AAL8BBL4BGGL8AAAGF+DEF+L4GG"πREM SWEET BETSY FROM PIKE:π  PLAY "T220 O3  L4CCEGGFDDCCL2CL4CCEG>CCC<BGG L2G L4G  >CCC <BGEFGA L2G L8CD L4EEE GFD DCCL3C" '1st time thru songπ  PLAY "L8CD L4EEE GFD DCC L2C L8CD L4EEE GFD DCC L2C L4C"  'this line is 1st CHORUSπ  PLAY "O3  L4CEGGFDDCCL2CL4CCEG>CCC<BGG L2G L4G  >CCC <BGEFGA L2G L8CD L4EEE GFD DCCL3C"  '2nd time thru songπ  PLAY "L8CD L4EEE GFD DCC L2C L8CD L4EEE GFD  L4DCCL2C"    '2nd time thur CHORUSπREM shortnin' bread :π PLAY "T120 O3 <L4F>L8DDL4CD<L8FF>L4DL2CL4<F>DCL8DD<L8AAL4GFN0 "π PLAY "T180 O4 < F >L8DDL4CD <F> DL2C <L4F >DL8CCL4D <AGF>N0"π PLAY "T200 O5 <L8FF> DD CC L4D <F> DCD   L8<FF>DDCC L4D <AGFN0"π PLAY "T250 O5 <L8FF>DDCCL4D<F>DCD L8<FF>DDCCL4D <AGFN0"πREM down at the station:π PLAY "T 180 O3 L4G L8GA L4BB L8AG AB L4GG L8BB B>CDDDDC<B>CD<L2B"π PLAY "O3 L8 GGGAL4BBL8AGABL4GG GG>DD <AB> <L2G"πREM Jingle Bells:π PLAY "T150 O3 L8BBL4BL8BBL4BL8B>D<GAL2B L8>CCCCC<BBBBAABL4A>D<"π PLAY "O3 L8BBL4BL8BBL4BL8B>D<GAL2B L8>CCCCC<BBB>DDC<AL2G"πREM merrily we roll along:π PLAY "T 200 O3 L4BAGABBL2BL4AAL2AL4BBL2BL4BAGABBL2BL4AABAL1G"π PLAY "T 200 O3 L4BAGABBL2BL4AAL2AL4BBL2BL4BAGABBL2BL4AABAL1G"πREM MICHAEL, ROW THE BOAT ASHORE:π PLAY "O3 L4FA MS L2ML>C<L8AL8>CDL2CL4<A>CL1DL2CL4<A>CMS L2MLC<L8A> L4C<AL2GL4FGL2AGF"π PLAY "O3 L4 FA MS L2ML>C<L8AL8>CDL2CL4<A>CL1DL2CL4<A>CMS L2MLC<L8A> L4C<AL2GL4FGL2AGF"πJohn Fischer                   PLAY MUSICAL HELPER            FidoNet QUIK_BAS Echo          07-17-96 (20:51)       QB, QBasic, PDS        319  10518    PLAYHELP.BAS'  > paid any attention to the PLAY syntax.  Now I've been looking aroundπ'  > and I find an alarming paucity of available programs written to showπ'  > off the PLAY function, so I'm contributing this one as a publicπ'  > service: ππ'I agree, and although sound cards are much better, PLAY *IS* a part of QBπ'(either flavor).  Here's a hastily written (and I mean HASTY) chuck of codeπ'that anyone is welcome to PLAY with.  BASICally, it will give you a veryπ'generic menu and let you input play commands into a buffer (sort of) andπ'then play them back for you, save them, etc..  I have NOT put an editorπ'into it, and probably won't, since I was just wanting to get more familiarπ'with PLAY.  One last thing, I forgot that the . (period) after a note DOESπ'make it a dotted note, even though that is NOT in the help section,π'therefore, I did not code for it.  IF anyone plays with this and makesπ'something of it, all I ask is for a copy it to poke around in.  Theπ'following is original and by posting it here I release it to the publicπ'domain. ππDECLARE FUNCTION Music$ (A$)πCLEARπON ERROR GOTO OoopsπIF COMMAND$ = "" THENπ     FileName$ = "MUSIC.SND"π     ELSE FileName$ = COMMAND$πEND IFπOPEN FileName$ FOR OUTPUT AS #1πCONST F1 = 59, F2 = 60, F3 = 61, F4 = 62, F10 = 68πNull$ = CHR$(0)πTemp$ = "O3 L4 T120 MN "πL = 4: O = 3: T = 120: T$ = " 7/8"πTopMenu:πCLS : COLOR 11πPRINT , "Input Keys to Play", "F10 = Help/Other Keys"πPRINT : COLOR 15πPRINT , "A - G)  Corresponding Note"πPRINT , "+ / -)  PREVIOUS Note SHARP or FLAT"πPRINT , "L)  Set Length of NEXT Notes (1-64)"πPRINT , "N)  Play a Note by it's Number (0-84)"πPRINT , "O)  Set Octave of NEXT Notes (0-6)"πPRINT , "P)  Pause for n ¼ Notes"πPRINT , "T)  Set # of ¼ Notes/Minute (32-255)"πPRINT , "< or > DOWN or UP 1 Octave"πPRINT , "1, 3, 7) Each Note FULL, 3/4, 7/8"πPRINT : COLOR 13πPRINT , "F1)  Play Your Tune", "F3) List Your Tune"πPRINT , "F2)  Start Over", "F4) PRINT Your Tune"πPRINT : COLOR 12πPRINT , "ESC)  Save and End Program"πCOLOR 14πLOCATE 5, 53: PRINT LπLOCATE 7, 53: PRINT OπLOCATE 9, 53: PRINT TπLOCATE 11, 53: PRINT T$πCOLOR 7πGetChoice: CHOICE$ = INKEY$πSELECT CASE UCASE$(CHOICE$)π     CASE IS = "/"π          CLS : SHELL: GOTO TopMenuπ     CASE IS = "*"π          CLS : SHELL "LIST": GOTO TopMenuπ     CASE IS = "`"π          CLS : SHELL "MUSIC.BAT": GOTO TopMenuπ     CASE IS = "1"π          Temp$ = Music$("ML")π          T$ = " Full ML"π          GOTO TopMenuπ     CASE IS = "3"π          Temp$ = Music$("MS")π          T$ = " 3/4 MS"π          GOTO TopMenuπ     CASE IS = "7"π          Temp$ = Music$("MN")π          T$ = " 7/8 MN"π          GOTO TopMenuπ     CASE IS = "A"π          Temp$ = Music$("A")π     CASE IS = "B"π          Temp$ = Music$("B")π     CASE IS = "C"π          Temp$ = Music$("C")π     CASE IS = "D"π          Temp$ = Music$("D")π     CASE IS = "E"π          Temp$ = Music$("E")π     CASE IS = "F"π          Temp$ = Music$("F")π     CASE IS = "G"π          Temp$ = Music$("G")π     CASE IS = "<"π          Temp$ = Music$("<")π          O = O - 1π          IF O < 0 THEN O = 0π          IF O > 6 THEN O = 6π          GOTO TopMenuπ     CASE IS = ","π          Temp$ = Music$("<")π          O = O - 1π          IF O < 0 THEN O = 0π          IF O > 6 THEN O = 6π          GOTO TopMenuπ     CASE IS = ">"π          Temp$ = Music$(">")π          O = O + 1π          IF O < 0 THEN O = 0π          IF O > 6 THEN O = 6π          GOTO TopMenuπ     CASE IS = "."π          Temp$ = Music$(">")π          O = O + 1π          IF O < 0 THEN O = 0π          IF O > 6 THEN O = 6π          GOTO TopMenuπ     CASE IS = "+"π          Temp$ = Music$("+")π     CASE IS = "-"π          Temp$ = Music$("-")π     CASE IS = "L"π          LOCATE 18, 20: PRINT "Range: 1 - 64"π          LOCATE 19, 20: INPUT "Length"; Aπ          IF A < 1 OR A > 64 THEN A = 4π          L = Aπ          Temp$ = Music$("L" + RTRIM$(LTRIM$(STR$(A))))π          GOTO TopMenuπ     CASE IS = "N"π          LOCATE 18, 20: PRINT "Range: 0 - 84"π          LOCATE 19, 20: INPUT "Note"; Aπ          IF A < 0 OR A > 84 THEN A = 4π          Temp$ = Music$("N" + RTRIM$(LTRIM$(STR$(A))))π          GOTO TopMenuπ     CASE IS = "O"π          LOCATE 18, 20: PRINT "Range: 0 - 6"π          LOCATE 19, 20: INPUT "Octave"; Aπ          IF A < 0 OR A > 6 THEN A = 0π          O = Aπ          Temp$ = Music$("O" + RTRIM$(LTRIM$(STR$(A))))π          GOTO TopMenuπ     CASE IS = "P"π          LOCATE 18, 20: PRINT "Range: 1 - 64"π          LOCATE 19, 20: INPUT "Pause Time"; Aπ          IF A < 1 OR A > 64 THEN A = 4π          Temp$ = Music$("P" + RTRIM$(LTRIM$(STR$(A))))π          GOTO TopMenuπ     CASE IS = "T"π          LOCATE 18, 20: PRINT "Range: 32 - 255"π          LOCATE 19, 20: INPUT "¼ Notes/Minute"; Aπ          IF A < 32 OR A > 255 THEN A = 120π          T = Aπ          Temp$ = Music$("T" + RTRIM$(LTRIM$(STR$(A))))π          GOTO TopMenuπ     CASE IS = Null$ + CHR$(F1)π          IF LEN(Temp$) > 0 THEN PRINT #1, Temp$π          Temp$ = "": CLOSE #1π          OPEN FileName$ FOR INPUT AS #1π          LOCATE 18π          DO UNTIL EOF(1)π               LINE INPUT #1, X$π               PRINT X$π               'PLAY "MB" + X$π               PLAY X$π          LOOPπ          CLOSE #1π          OPEN FileName$ FOR APPEND AS #1π          COLOR 15π          PRINT : PRINT "Press the SPACEBAR to resume"π          COLOR 7π          SLEEPπ          DO UNTIL INKEY$ = "": LOOPπ          GOTO TopMenuπ     CASE IS = Null$ + CHR$(F2)π          Temp$ = "O3 L4 T120 MN "π          CLOSE #1π          OPEN FileName$ FOR OUTPUT AS #1π          LOCATE 18, 20π          COLOR 15π          PRINT "All Music Cleared"π          COLOR 7π          SLEEP 1π          L = 4: O = 3: T = 120: T$ = " 7/8"π          GOTO TopMenuπ     CASE IS = Null$ + CHR$(F3)π          IF LEN(Temp$) > 0 THEN PRINT #1, Temp$π          Temp$ = ""π          CLOSE #1π          OPEN FileName$ FOR INPUT AS #1π          LOCATE 18π          DO UNTIL EOF(1)π               LINE INPUT #1, X$π               PRINT X$π          LOOPπ          CLOSE #1π          OPEN FileName$ FOR APPEND AS #1π          COLOR 15π          PRINT : PRINT "Press the SPACEBAR to resume"π          COLOR 7π          SLEEPπ          DO UNTIL INKEY$ = "": LOOPπ          GOTO TopMenuπ     CASE IS = Null$ + CHR$(F4)π          IF LEN(Temp$) > 0 THEN PRINT #1, Temp$π          Temp$ = ""π          CLOSE #1π          OPEN FileName$ FOR INPUT AS #1π          OPEN "PRN" FOR OUTPUT AS #2π          DOπ               LINE INPUT #1, X$π               PRINT #2, X$π          LOOP UNTIL EOF(1)π          PRINT #2, ""π          CLOSE #2π          CLOSE #1π          OPEN FileName$ FOR APPEND AS #1π          GOTO TopMenuπ     CASE IS = Null$ + CHR$(F10)π          CLSπ          COLOR 14π          PRINTπ          PRINT , "T20  = 1/2 time", "T40 = 2/2 time"π          PRINT , "T80  = 2/4 time", "T120 = 3/4 time"π          PRINT , "T160 = 4/4 time", "T240 = 6/8 time"π          PRINTπ          PRINT , "L1 = Whole Note", "L2 = Half Note"π          PRINT , "L4 = Quarter Note", "L8 = Eighth Note"π          PRINT , "L16 = Sixteenth Note", "L32 = Thirty-Second Note"π          PRINTπ          PRINT , "Octave: Higher the number, higher the pitch"π          PRINTπ          COLOR 3π          PRINT , "Other MAIN MENU Commands Available"π          PRINT , "` Run file MUSIC.BAT if it exists"π          PRINT , "~ create MUSIC_QB.BAS (PLAYable)"π          PRINT , "* Run LIST"π          PRINT , "/ DOS Shell"π          COLOR 15π          PRINT : PRINT , "Press the SPACEBAR to continue"π          COLOR 7π          SLEEPπ          DO UNTIL INKEY$ = "": LOOPπ          CLSπ          COLOR 14π          PRINT , "Central Octave Chart"π          COLOR 2π          PRINTπ          PRINT , "                     B"π          PRINT , "                  ── A ──"π          PRINT , "                     G"π          PRINT , "──────────────────── F ───────   Octave #4"π          PRINT , "                     E"π          PRINT , "──────────────────── D ───────"π          PRINT , "                     C"π          COLOR 10π          PRINT , "─────────────── B ────────────"π          PRINT , "                A"π          PRINT , "─────────────── G ────────────"π          PRINT , "                F                Octave #3"π          PRINT , "─────────────── E ────────────   (Default)"π          PRINT , "                D"π          PRINT , "             ── C ──"π          COLOR 15π          PRINT : PRINT , "You MUST shift octaves to use the entire scale"π          PRINT : PRINT , "Press the SPACEBAR to continue"π          COLOR 7π          SLEEPπ          DO UNTIL INKEY$ = "": LOOPπ          GOTO TopMenuπ     CASE IS = CHR$(27)π          PRINT #1, Temp$π          CLOSE #1π          LOCATE 22π          ENDπ     CASE IS = "~"π          PRINT #1, Temp$: Temp$ = ""π          CLOSE #1π          OPEN FileName$ FOR INPUT AS #1π          OPEN "MUSIC_QB.BAS" FOR OUTPUT AS #2π          PRINT #2, "CLS : CLEAR"π          PRINT #2, "PLAY " + CHR$(34) + "MB" + CHR$(34)π          PRINT #2, "'The Above line switches to BACKGROUND playing"π          DO UNTIL EOF(1)π               LINE INPUT #1, Bas$π               IF Bas$ <> "" THENπ                    Bas1$ = "PRINT " + CHR$(34) + Bas$ + CHR$(34)π                    Bas2$ = "PLAY " + CHR$(34) + Bas$ + CHR$(34)π                    PRINT #2, Bas1$π                    PRINT #2, Bas2$π               END IFπ          LOOPπ          PRINT #2, "PLAY " + CHR$(34) + "MF" + CHR$(34)π          PRINT #2, "'The Above line switches back to FOREGROUND playing"π          PRINT #2, "END"π          CLOSE #2π          CLOSE #1π          OPEN FileName$ FOR APPEND AS #1π     CASE ELSEπ          GOTO GetChoiceπEND SELECTπGOTO GetChoiceπLOCATE 22πENDπOoops:πCOLOR 7πCLSπCLOSEπOPEN "MUSIC.ERR" FOR APPEND AS #1πPRINT #1, TIME$, DATE$, ERRπCLOSE #1πPRINT : PRINT "An error has occured: #"; ERRπPRINT "See file MUSIC.ERR for QB4.5 error number"πENDππFUNCTION Music$ (Add$)πSHARED Temp$πKill$ = "ABCDEFG"πIF INSTR(Kill$, Add$) > 0 THENπ     Temp$ = Temp$ + Add$π     ELSE Temp$ = Temp$ + Add$π          IF LEN(Temp$) >= 50 THEN PRINT #1, Temp$: Temp$ = ""πEND IFπMusic$ = Temp$πEND FUNCTIONπLloyd Chang                    ADLIB SOUND EFFECTS            FidoNet QUIK_BAS Echo          08-05-96 (18:39)       QB, QBasic, PDS        358  12335    ADLIBFX.BAS ' > Anyway,  I really need to get adlib sound into my Qb4.5 programs. ππ'I hope ADLIB.BAS will help.  It's included at the bottom of thisπ'message.ππ'As to making your own sound effects (in non-mathematical form),π'I have not yet figured out how to do that.  Tim Truman'sπ'defender game comes with six sound effects.  Perhaps you wantπ'to examine those first.ππ'Just in case you want to contact Tim Truman, his AOL accountπ'is "Tim Truman" and his Compuserve address is "74734,2203"ππ'I have not contacted him yet but the addresses should stillπ'work since his Defender game was written in 1995 and revisedπ'in 1996.ππ'I believe you can also reach him via the internet through hisπ'Compuserve address (but I don't really know how Compuserveπ'converts its user addresses into Internet addresses).ππ'------------------------------ CUT HERE ------------------------------ππ'ADLIB.BASπ'Written by Lloyd Changππ'ADLIB.BAS is meant to provideπ'a skeleton to the use of an adlibπ'sound effects in QuickBASICππ'.---------.π'| NOTICE: |π'`---------'π'The functions, sub-routines, and adlib detectionπ'are stripped from Defender, a QuickBASIC gameπ'written by Tim Truman (based on the Defenderπ'game on the Atari 2600).ππDECLARE FUNCTION adlib ()               ' detects presence of adlibπDECLARE SUB WriteReg (reg, value)       ' write to adlibs registersπDECLARE SUB adlibfx (num)               ' plays the soundsππDEFINT A-ZππIF adlib THENπ  adlibsound = TRUEπ  PRINT "Adlib detected"π  SLEEP (1)πEND IFππadlibfx (0)πSLEEP 1πadlibfx (1)πSLEEP 2πadlibfx (0)πSLEEP 3πadlibfx (1)πSLEEP 4πadlibfx (0)πSLEEP 5πadlibfx (1)πSLEEP 6ππDEFSNG A-ZπFUNCTION adlibππ  '  Detects an AdLib-compatible card.π  '  Returns 1 (true) if detected and 0 (false) if not.π  π π   CALL WriteReg(&H4, &H60)  '  Resets both Timersπ   CALL WriteReg(&H4, &H80)  '  Enables Interruptsπ   b = INP(&H388)            '  Store the resultπ   CALL WriteReg(&H2, &HFF)  '  Write FFh to register 2 (Timer 1)π   CALL WriteReg(&H4, &H21)  '  Start Timer 1ππ   FOR x = 0 TO 130          '  Delay for 80 Microsecondsπ      a = INP(&H388)π   NEXT xππ   c = INP(&H388)                 '  Store the resultπ   CALL WriteReg(&H4, &H60)       '  Reset Timersπ   CALL WriteReg(&H4, &H80)       '  Reset Interrruptsπ   Success = 0π   IF (b AND &HE0) = &H0 THEN     '  Test resultπ     IF (c AND &HE0) = &HC0 THEN  '  Test Resultπ       Success = 1π       FOR q = 1 TO &HF5          '  clear registersπ         CALL WriteReg(q, 0)π       NEXT qπ     END IFπ   END IFπ   adlib = SuccessπππEND FUNCTIONππSUB adlibfx (num)ππ SELECT CASE (num)ππ CASE (0)                    '   mutant explodingππ π   WriteReg &HB0, &H0π   numberl = 60π   numberh = 1π   block = 0π                                 ' Modulatorπ   CALL WriteReg(&H20, &H0)      ' Multiple - 0 to Fπ   CALL WriteReg(&H40, &H0)      ' Attenuation Level -  0 to 3Fπ   CALL WriteReg(&H60, &HA5)     ' Attack: (High byte)    Decay: (Low byte)π   CALL WriteReg(&H80, &H0)      ' Sustain: (High byte)   Release: (Low byte)π   CALL WriteReg(&HE0, &HF0)     ' Waveform select  0 to 3π                                ' Carrierπ   CALL WriteReg(&H23, &H0)      ' Multiple  - 0 to Fπ   CALL WriteReg(&H43, &H0)      ' Attenuation level -  0 to 3Fπ   CALL WriteReg(&H63, &HA6)     ' Attack: (High byte)   Decay:(low byte)π   CALL WriteReg(&H83, &HAA)     ' Sustain: (High Byte)  Release:(low byte)π   CALL WriteReg(&HE1, &HF0)     ' Waveform select  0 to 3ππ   keyon% = &H20ππ   Byte = keyon% + (block * 4) + numberh%ππ   CALL WriteReg(&HA0, numberl)     ' F-Number(L)  0 to 255π   CALL WriteReg(&HB0, Byte)     ' Sound voice ,Set block ,Set F-Number(H)πππ CASE 1                 'hero firingππ  WriteReg &HB1, &H0ππ  numberl = 230π  numberh = 1π  block = 1π                              ' Modulatorπ  CALL WriteReg(&H21, &H10)    ' Multiple - 0 to Fπ  CALL WriteReg(&H41, &H0)    ' Attenuation Level -  0 to 3Fπ  CALL WriteReg(&H61, &H66)   ' Attack: (High byte)    Decay: (Low byte)π  CALL WriteReg(&H81, &HF6)   ' Sustain: (High byte)   Release: (Low byte)π  CALL WriteReg(&HE1, &HF2)   ' Waveform select  0 to 3π                              ' Carrierπ  CALL WriteReg(&H24, &H0)    ' Multiple  - 0 to Fπ  CALL WriteReg(&H44, &H6)    ' Attenuation level -  0 to 3Fπ  CALL WriteReg(&H64, &H63)   ' Attack: (High byte)   Decay:(low byte)π  CALL WriteReg(&H84, &HF8)    ' Sustain: (High Byte)  Release:(low byte)π  CALL WriteReg(&HE4, &HF0)   ' Waveform select  0 to 3ππ  keyon = &H20ππ  Byte = keyon + (block * 4) + (numberh)ππ  CALL WriteReg(&HC1, 0)            ' conectionπ  CALL WriteReg(&HC1, 0)            ' conectionπ  CALL WriteReg(&HA1, numberl)     ' F-Number(L)  0 to 255π  CALL WriteReg(&HB1, Byte)     ' Sound voice ,Set block ,Set F-Number(H)ππ  '  WriteReg &HB1, &H0          ' stop noiseππ  '  numberl = 10π  '  numberh = 0π   ' block = 7π                                ' Modulatorπ  '  CALL WriteReg(&H21, &H3)     ' Multiple - 0 to Fπ  '  CALL WriteReg(&H41, &H0)    ' Attenuation Level -  0 to 3Fπ  '  CALL WriteReg(&H61, &H99)   ' Attack: (High byte)    Decay: (Low byte)π  '  CALL WriteReg(&H81, &HFF)   ' Sustain: (High byte)   Release: (Low byte)π  '  CALL WriteReg(&HE1, &HF0)   ' Waveform select  0 to 3π                                ' Carrierπ  '  CALL WriteReg(&H24, &H1)    ' Multiple  - 0 to Fπ  '  CALL WriteReg(&H44, &H0)    ' Attenuation level -  0 to 3Fπ  '  CALL WriteReg(&H64, &HAD)   ' Attack: (High byte)   Decay:(low byte)π   ' CALL WriteReg(&H84, &H55)   ' Sustain: (High Byte)  Release:(low byte)π  '  CALL WriteReg(&HE4, &HF0)   ' Waveform select  0 to 3ππ  '  keyon% = &H20ππ  '  Byte = keyon% + (block * 4) + numberhππ  ' CALL WriteReg(&HA1, numberl)     ' F-Number(L)  0 to 255π  ' CALL WriteReg(&HB1, Byte)     ' Sound voice ,Set block ,Set F-Number(H)ππππ CASE 2                       ' colonist pick up warningππ  WriteReg &HB2, &H0          ' stop noiseππ  numberl = 255π  numberh = 3π  block = 2π                              ' Modulatorπ  CALL WriteReg(&H22, &H3)    ' Multiple - 0 to Fπ  CALL WriteReg(&H42, &H0)    ' Attenuation Level -  0 to 3Fπ  CALL WriteReg(&H62, &H5F)   ' Attack: (High byte)    Decay: (Low byte)π  CALL WriteReg(&H82, &HFF)   ' Sustain: (High byte)   Release: (Low byte)π  CALL WriteReg(&HE2, &HF0)   ' Waveform select  0 to 3π                              ' Carrierπ  CALL WriteReg(&H25, &H0)    ' Multiple  - 0 to Fπ  CALL WriteReg(&H45, &H9)    ' Attenuation level -  0 to 3Fπ  CALL WriteReg(&H65, &H5F)   ' Attack: (High byte)   Decay:(low byte)π  CALL WriteReg(&H85, &HFF)   ' Sustain: (High Byte)  Release:(low byte)π  CALL WriteReg(&HE5, &HF0)   ' Waveform select  0 to 3ππ  keyon% = &H20ππ  Byte = keyon% + (block * 4) + numberhππ  CALL WriteReg(&HA2, numberl)     ' F-Number(L)  0 to 255π  CALL WriteReg(&HB2, Byte)     ' Sound voice ,Set block ,Set F-Number(H)πππ CASE 3                         ' mutant convertedπ    WriteReg &HB3, &H0ππ    numberl = 10π    numberh = 0π    block = 5π                                ' Modulatorπ    CALL WriteReg(&H28, &H5)     ' Multiple - 0 to Fπ    CALL WriteReg(&H48, &H0)    ' Attenuation Level -  0 to 3Fπ    CALL WriteReg(&H68, &H99)   ' Attack: (High byte)    Decay: (Low byte)π    CALL WriteReg(&H88, &HFF)   ' Sustain: (High byte)   Release: (Low byte)π    CALL WriteReg(&HE8, &HF0)   ' Waveform select  0 to 3π                                ' Carrierπ    CALL WriteReg(&H2B, &H0)    ' Multiple  - 0 to Fπ    CALL WriteReg(&H4B, &H0)    ' Attenuation level -  0 to 3Fπ    CALL WriteReg(&H6B, &HAD)   ' Attack: (High byte)   Decay:(low byte)π    CALL WriteReg(&H8B, &H55)   ' Sustain: (High Byte)  Release:(low byte)π    CALL WriteReg(&HEB, &HF0)   ' Waveform select  0 to 3ππ    keyon% = &H20π π    Byte = keyon% + (block * 4) + numberhππ   CALL WriteReg(&HA3, numberl)     ' F-Number(L)  0 to 255π   CALL WriteReg(&HB3, Byte)     ' Sound voice ,Set block ,Set F-Number(H)ππ CASE 4           ' mutant firingππ    WriteReg &HB4, &H0          ' stop noiseππ    numberl = 10π    numberh = 0π    block = 1π                                ' Modulatorπ    CALL WriteReg(&H29, &H5)     ' Multiple - 0 to Fπ    CALL WriteReg(&H49, &H0)    ' Attenuation Level -  0 to 3Fπ    CALL WriteReg(&H69, &H87)   ' Attack: (High byte)    Decay: (Low byte)π    CALL WriteReg(&H89, &HFF)   ' Sustain: (High byte)   Release: (Low byte)π    CALL WriteReg(&HE9, &HF0)   ' Waveform select  0 to 3π                                ' Carrierπ    CALL WriteReg(&H2C, &H1)    ' Multiple  - 0 to Fπ    CALL WriteReg(&H4C, &H9)    ' Attenuation level -  0 to 3Fπ    CALL WriteReg(&H6C, &HA5)   ' Attack: (High byte)   Decay:(low byte)π    CALL WriteReg(&H8C, &H55)   ' Sustain: (High Byte)  Release:(low byte)π    CALL WriteReg(&HEC, &HF0)   ' Waveform select  0 to 3ππ    keyon% = &H20ππ    Byte = keyon% + (block * 4) + numberhππ   CALL WriteReg(&HA4, numberl)     ' F-Number(L)  0 to 255π   CALL WriteReg(&HB4, Byte)     ' Sound voice ,Set block ,Set F-Number(H)π π CASE 5ππ   'PRINT " bomer noise"π   WriteReg &HB5, &H0          ' stop noiseππ    numberl = 60π    numberh = 1π    block = 2π                                ' Modulatorπ    CALL WriteReg(&H2A, &H0)    ' Multiple - 0 to Fπ    CALL WriteReg(&H4A, &H0)    ' Attenuation Level -  0 to 3Fπ    CALL WriteReg(&H6A, &H55)   ' Attack: (High byte)    Decay: (Low byte)π    CALL WriteReg(&H8A, &HAA)   ' Sustain: (High byte)   Release: (Low byte)π    CALL WriteReg(&HEA, &HF3)   ' Waveform select  0 to 3π                                ' Carrierπ    CALL WriteReg(&H2D, &H0)    ' Multiple  - 0 to Fπ    CALL WriteReg(&H4D, &H0)    ' Attenuation level -  0 to 3Fπ    CALL WriteReg(&H6D, &HFF)   ' Attack: (High byte)   Decay:(low byte)π    CALL WriteReg(&H8D, &HAA)   ' Sustain: (High Byte)  Release:(low byte)π    CALL WriteReg(&HED, &HF3)   ' Waveform select  0 to 3πππ   CALL WriteReg(&HC5, 1)            ' conectionππ   keyon% = &H20ππ   Byte = keyon% + (block * 4) + numberhππ   CALL WriteReg(&HA5, numberl)     ' F-Number(L)  0 to 255π   CALL WriteReg(&HB5, Byte)     ' Sound voice ,Set block ,Set F-Number(H)πππ  CASE 6ππ   WriteReg &HB4, &H0π   numberl = 130π   numberh = 0π   block = 0π                                 ' Modulatorπ   CALL WriteReg(&H29, &H0)      ' Multiple - 0 to Fπ   CALL WriteReg(&H49, &H0)      ' Attenuation Level -  0 to 3Fπ   CALL WriteReg(&H69, &HA5)     ' Attack: (High byte)    Decay: (Low byte)π   CALL WriteReg(&H89, &H0)      ' Sustain: (High byte)   Release: (Low byte)π   CALL WriteReg(&HE9, &HF0)     ' Waveform select  0 to 3π                                ' Carrierπ   CALL WriteReg(&H2C, &H0)      ' Multiple  - 0 to Fπ   CALL WriteReg(&H4C, &H0)      ' Attenuation level -  0 to 3Fπ   CALL WriteReg(&H6C, &HA6)     ' Attack: (High byte)   Decay:(low byte)π   CALL WriteReg(&H8C, &H55)     ' Sustain: (High Byte)  Release:(low byte)π   CALL WriteReg(&HEC, &HF0)     ' Waveform select  0 to 3ππ   keyon% = &H20ππ   Byte = keyon% + (block * 4) + numberh%ππ   CALL WriteReg(&HA4, numberl)     ' F-Number(L)  0 to 255π   CALL WriteReg(&HB4, Byte)     ' Sound voice ,Set block ,Set F-Number(H)ππππ END SELECTππEND SUBππSUB WriteReg (reg, value)ππ' Writes to AdLib's registers the delays required when writing to theseπ' ports are present.π'π' Reg is the register to write to. Value is the data to send.πππOUT &H388, reg     '  388h = Register/Status portπ                   '  Tells the SB what register we want to write toππ                   '  Calling the register port 6 times creates anπ                   '  accurate delay of 3.3ms. This delay is requiredπFOR x = 0 TO 5     '  after writing to the register port.π   a = INP(&H388)πNEXT xππOUT &H389, value   '  389h = data portπ                   '  send data that corrisponds with the requested register.ππ                   '  Calling the data port 35 times creates anπ                   '  accurate delay of 23ms. This delay is required.πFOR x = 0 TO 34    '  after writing to the data port.π   a = INP(&H388)πNEXT xπππEND SUBπ[e-mail]                PLAY ADLIB                     comp.lang.basic.misc           08-04-96 (22:16)       QB, QBasic, PDS        158  5401     PADLIB.BAS  'You say you wanted SoundBlaser code?  I've written a SUB that works withπ'an AdLib-compatible speaker.  I think a SoundBlaster works too (at least,π'mine does).  It is very easy to use.  It uses the same command string thatπ'the PLAY command does.  The only difference is that at the top of yourπ'program you have to do aππCALL PlayAdLib("{INIT}")ππ'to set the variables.  Here's the code:ππSUB PlayAdLib (comand$)π  STATIC tempo, length, music, octaveππ  IF comand$ = "{INIT}" THENπ    tempo = 120π    length = 4π    music = 7 / 8π    octave = 4π    EXIT SUBπ  END IFππ  comand$ = UCASE$(comand$)π  FOR i% = 0 TO 224π    WriteReg i%, 0 'Clear all registersπ  NEXT i%π  WriteReg &H20, &H1 'Plays carrier note at specified octave ch. 1π  WriteReg &H23, &H1 'Plays modulator note at specified octave ch. 1π  WriteReg &H40, &H1F 'Set carrier total level to softest ch. 1π  WriteReg &H43, &H0 'Set modulator level to loudest ch. 1π  WriteReg &H60, &HE4 'Set carrier attack and decay ch. 1π  WriteReg &H63, &HE4 'Set modulator attack and decay ch. 1π  WriteReg &H80, &H9D 'Set carrier sustain and release ch. 1π  WriteReg &H83, &H9D 'Set modulator sustain and release ch. 1π π  c% = 1π  max% = LEN(comand$)π  WHILE c% <= max%π    x$ = MID$(comand$, c%, 1): c% = c% + 1    'extract subcommandπ    IF INSTR("ABCDEFG", x$) <> 0 AND (c% <> max% AND INSTR("+#-", MID$(comand$, c%, 1))) THENπ      x$ = x$ + MID$(comand$, c%, 1): c% = c% + 1π      IF RIGHT$(x$, 1) = "+" THEN x$ = LEFT$(x$, 1) + "#"π      IF x$ = "D-" THEN x$ = "C#"π      IF x$ = "E-" THEN x$ = "D#"π      IF x$ = "G-" THEN x$ = "F#"   'convert all flats into equivalent sharpsπ      IF x$ = "A-" THEN x$ = "G#"π      IF x$ = "B-" THEN x$ = "A#"π    ELSEIF x$ = "O" THENπ      adj% = VAL(MID$(comand$, c%, 1)): c% = c% + 1π      IF adj% >= 0 AND adj% <= 6 THEN octave = adj%π    ELSEIF x$ = "<" AND octave > 0 THENπ      octave = octave - 1π    ELSEIF x$ = ">" AND octave < 6 THENπ      octave = octave + 1π    ELSEIF x$ = "L" THENπ      num$ = ""π      WHILE INSTR("0123456789", MID$(comand$, c%, 1))π        num$ = num$ + MID$(comand$, c%, 1): c% = c% + 1π      WENDπ      IF VAL(LTRIM$(num$)) >= 1 AND VAL(LTRIM$(num$)) <= 64 THEN length = VAL(LTRIM$(num$))π    ELSEIF x$ = "P" THENπ      dotfac = 1π      num$ = ""π      WHILE INSTR("0123456789", MID$(comand$, c%, 1))π        num$ = num$ + MID$(comand$, c%, 1): c% = c% + 1π      WENDπ      WHILE MID$(comand$, c%, 1) = "."π        dotfac = dotfac * 1.5: c% = c% + 1π      WENDπ      IF VAL(num$) >= 1 AND VAL(num$) <= 64 THENπ        start! = TIMERπ        ender! = start! + (((1 / VAL(num$)) * dotfac) * ((tempo / 120) * 2) * music)π        DOπ        LOOP UNTIL TIMER >= ender!  'start! + (1 / VAL(num$))π      END IFπ    ELSEIF x$ = "M" THENπ      next$ = MID$(comand$, c%, 1): c% = c% + 1π      x$ = x$ + next$π      IF x$ = "MN" THEN music = 7 / 8π      IF x$ = "MS" THEN music = 3 / 4π      IF x$ = "ML" THEN music = 1ππ    END IFπ    IF INSTR("ABCDEFG", LEFT$(x$, 1)) THENπ      dotfac = 1π      WHILE MID$(comand$, c%, 1) = "."π        dotfac = dotfac * 1.5: c% = c% + 1π      WENDπ      SELECT CASE x$π      CASE "C#"π        WriteReg &HA0, &H6B                 'Set note numberπ        WriteReg &HB0, &H21 + 4 * octave    'Set octave and turn on voiceπ      CASE "D"π        WriteReg &HA0, &H81π        WriteReg &HB0, &H21 + 4 * octaveπ      CASE "D#"π        WriteReg &HA0, &H98π        WriteReg &HB0, &H21 + 4 * octaveπ      CASE "E"π        WriteReg &HA0, &HB0π        WriteReg &HB0, &H21 + 4 * octaveπ      CASE "F"π        WriteReg &HA0, &HCAπ        WriteReg &HB0, &H21 + 4 * octaveπ      CASE "F#"π        WriteReg &HA0, &HE5π        WriteReg &HB0, &H21 + 4 * octaveπ      CASE "G"π        WriteReg &HA0, &H2π        WriteReg &HB0, &H22 + 4 * octaveπ      CASE "G#"π        WriteReg &HA0, &H20π        WriteReg &HB0, &H22 + 4 * octaveπ      CASE "A"π        WriteReg &HA0, &H41π        WriteReg &HB0, &H22 + 4 * octaveπ      CASE "A#"π        WriteReg &HA0, &H63π        WriteReg &HB0, &H22 + 4 * octaveπ      CASE "B"π        WriteReg &HA0, &H87π        WriteReg &HB0, &H22 + 4 * octaveπ      CASE "C"π        WriteReg &HA0, &HAEπ        WriteReg &HB0, &H22 + 4 * (octave - 1)π      END SELECTπ      start! = TIMERπ      ender! = start! + (((1 / length) * dotfac) * ((tempo / 120) * 2) * music)π      DOπ      LOOP UNTIL TIMER >= ender!  '(start! + (1 / length))π      WriteReg &HB0, 0π    END IFπ  WENDπEND SUBππSUB WriteReg (reg AS INTEGER, value AS INTEGER)π                      '&H is QBASIC hexadecimal prefixπ  OUT &H388, reg      '&H388 is AdLib register/status portπ                      'tells what register to write toπ π  FOR c% = 0 TO 5     'reading hardware port 6 times creates manditory 3.3 msπ    a% = INP(&H388)   'delayπ  NEXT c%ππ  OUT &H389, value    '&H389 is AdLib data portπ                      'sends data to the register specified aboveπ                     π  FOR c% = 0 TO 34    'reading reg/stat port 35 times creates manditoryπ    a% = INP(&H388)   '23 ms delayπ  NEXT c%πEND SUBππ'(The WriteReg SUB is needed for PlayAdLib to work.)ππ'I have a few other SUBs on my WWW site.  The address is in my signature.π'Glad I could help.ππ'- [e-mail]π'  http://home.aol.com/Borg953πTony Cave                       BOTTLES OF BEER ON THE WALL FidoNet QUIK_BAS Echo          08-13-96 (20:58)       QB, QBasic, PDS        25   786      BEER.BAS    'Here's something for your computer to do when it gets bored.ππCLSπsong$ = "l8T255<<n25n25n25p8n20n20n20p8n25n25n25n25p8n24n25n26"πsong$ = song$ + "n27n27n27p8n22n22n22n27p8n27n25p8n24p8n22p8"πsong$ = song$ + "n24p8n24p8n24p8p8p8n24n24n24n24p8p8p8p8n20n20n20p8"πsong$ = song$ + "n22n22n24p8n25n25n25n25"πup$ = "p8n20n22n24"πDOπFOR x = 99 TO 1 STEP -1πCLSπLOCATE RND * 22 + 1, 1πPRINT x; "bottles of beer on the wall,"; x; "bottles of beer."πPRINT " Take one down; pass it around. ";πIF x - 1 <> 0 THEN PRINT x - 1;  ELSE PRINT " No ";πPRINT "bottles of beer on the wall."πPLAY song$πIF x - 1 <> 0 THEN PLAY up$πa$ = INKEY$: IF a$ <> "" THEN SYSTEMπNEXTπCLS : LOCATE 1, 1πPRINT "One more time"πSLEEP 2&: m$ = INKEY$πIF m$ <> "" THEN DO: LOOP UNTIL m$ <> ""πLOOPπKurt Eckhardt                  SOUND BLASTER PIANO            [e-mail]                08-20-96 (00:00)       QB, QBasic, PDS        332  11389    SBPIANO.BAS 'Coded by Kurt Eckhardt 08/20/96π'The graphics are sketchy, but this program was designed more for exampleπ'that anything else. Try Decay rates of 0-5, they sound best.ππ'I have a generic sound card and the program seems to work fine.π'However, tested on a friends computer who has a true SBpro, produced mixedπ'results (actually it sounded like crap). Sorry if it doesn't work on yourπ'Cpu, but it is Version 1.0ππDEFINT A-ZπDECLARE SUB legal ()πDECLARE SUB info ()πDECLARE SUB pressakey ()πDECLARE SUB Menu ()πDECLARE SUB SBDrum (num%)πDECLARE SUB SBPlay (channel%, n$, Octa%)πDECLARE SUB WriteReg (Reg%, value%)πDECLARE SUB InitCard ()πDECLARE SUB Scale ()πDECLARE SUB pause (secs!)πDECLARE SUB center (text$, row!)πDECLARE FUNCTION offset1% (channel%)πDECLARE FUNCTION offset2% (channel%)πDECLARE FUNCTION DetectCard% ()πDECLARE FUNCTION note% (n$)πCONST StatusP = &H388            'Status portπCONST DataP = &H389              'Data portπCONST TRUE = 1πDIM SHARED tst, vstπDIM SHARED dcayππCLS : CALL infoπCALL legal: CLSπIF DetectCard = TRUE THENπ   PRINT "We have a soundcard!"πELSEπ   PRINT "Go buy yourself a soundcard!"π   SYSTEM: ENDπEND IFπPRINT "Initalizing Card...": InitCardπPRINT "Ok"πPRINT "Press any key to continue": pressakeyππCALL Menuππ'Make sure all registers are cleared before closingπCALL WriteReg(&HB0, 0)πCALL InitCardπSYSTEM: ENDππDEFSNG A-ZπSUB center (text$, row)πtext$ = RTRIM$(text$)πLOCATE row, 40 - LEN(text$) / 2πPRINT text$πEND SUBππDEFINT A-ZπFUNCTION DetectCardπCALL WriteReg(&H4, &H60)        'Reset both timersπCALL WriteReg(&H4, &H80)πstat1 = INP(&H388)              'Store resultπCALL WriteReg(&H2, &HFF)πCALL WriteReg(&H4, &H21)πpause .08                       'Wait 80msecsπstat2 = INP(&H388)              'Store resultπCALL WriteReg(&H4, &H60)        'Reset both timersπCALL WriteReg(&H4, &H80)πIF (stat1 AND &HE0) = &H0 THENπ   IF (stat2 AND &HE0) = &HC0 THENπ      found = TRUEπ   END IFπEND IFπDetectCard = foundπEND FUNCTIONππSUB infoπCLSπPRINT "Coded and Designed by Kurt Eckhardt"πPRINT "Copyrite 1996   All Rights Reserved"πPRINT "V1.0 Completed on 8/20/96"πPRINT "Channels 1 through 3 appear to be working correctly as do the drums (I think)"πPRINT "But channels 4-9 only produce muted/distorted sounds, if any at all."πPRINT "Vibrato and Tremolo are operational, but the effect cannot be heard"πPRINT "If the decay is set too short."πPRINT "Sorry about the sharps, they work, but no keyboard interface yet."πPRINT "You'll have to wait until I put in mouse support."πPRINT "If you find any info in this program useful for your own programming endevours,"πPRINTπPRINT "I would greatly appreciate you sending me 1$ so I can make my way through"πPRINT "college. I bet you can look around right now and find that within 10 feet"πPRINT "of yourself- if not, you are as broke as I am."πPRINT "Any comments or questions, send me some email at <[e-mail]>"πPRINT "Here's the address for that measly buck: "πPRINTπPRINT "Kurt Eckhardt"πPRINT "1820 West Oak Knoll Circle"πPRINT "Ft. Lauderdale FL 33324"πPRINTπPRINT "Thanks!"πpressakeyπEND SUBππSUB InitCardπ'Set all 244 registers to 0 to initalizeπFOR lp = 1 TO 2πFOR Regis = 1 TO &HF5πCALL WriteReg(Regis, 0)πNEXT RegisπNEXT lpππ'Set variablesπdcay = 5: vst = 0: tst = 0πEND SUBππSUB legalπCLSπcenter "Legal Stuff", 1πPRINTπPRINT "1. This program may be freely distributed so long as no changes have been made."πPRINT "2. This program, or any part of it, may not be used in another program"πPRINT "   without my written consent."πPRINT "3. I take no responsibilty for any adverse affects that may be caused by"πPRINT "   usage of this program upon your machine."π                     πcenter "By possessing this program you agree with these terms.", 10πpressakeyπEND SUBππSUB MenuπSCREEN 12: CLSππCOLOR 2: center "One Really Bad Music Machine", 1πcenter "By: Kurt Eckhardt  V1.0", 2: COLOR 15πππLOCATE 5, 1: COLOR 11: PRINT "6: "; : COLOR 3: PRINT "Tremolo: OFF"πLOCATE 6, 1: COLOR 11: PRINT "7: "; : COLOR 3: PRINT "Vibrato: OFF"πLOCATE 5, 66: COLOR 11: PRINT "8: "; : COLOR 3: PRINT "Decay: "; HEX$(dcay)πLOCATE 15, 8: COLOR 11: PRINT "0: "; : COLOR 9: PRINT "Quit"πLOCATE 16, 8: COLOR 11: PRINT "1: "; : COLOR 9: PRINT "Hi Hat"πLOCATE 17, 8: COLOR 11: PRINT "2: "; : COLOR 9: PRINT "Symbol"πLOCATE 18, 8: COLOR 11: PRINT "3: "; : COLOR 9: PRINT "Tom Drum"πLOCATE 19, 8: COLOR 11: PRINT "4: "; : COLOR 9: PRINT "Snare Drum"πLOCATE 20, 8: COLOR 11: PRINT "5: "; : COLOR 9: PRINT "Bass Drum"ππCOLOR 11πLOCATE 26, 8: PRINT "C  D  E   F  G  A  B"πLOCATE 26, 30: PRINT "C  D  E   F  G  A  B"πLOCATE 26, 52: PRINT "C  D  E   F  G  A  B  C"πLOCATE 22, 8: PRINT "C# D#    F# G#  A#"πLOCATE 22, 30: PRINT "C# D#    F# G#  A#"πLOCATE 22, 52: PRINT "C# D#    F# G#  A#    C#"ππCOLOR 9πFOR x = 50 TO 575 STEP 25πLINE (x, 330)-(x + 25, 420), , BπNEXT xπLINE (50, 365)-(600, 365)ππDOπ   key$ = UCASE$(INKEY$)π   SELECT CASE key$π   CASE "Z": CALL SBPlay(1, "C", 4): xpos = 8: char$ = "C"π   CASE "X": CALL SBPlay(1, "D", 4): xpos = 11: char$ = "D"π   CASE "C": CALL SBPlay(1, "E", 4): xpos = 14: char$ = "E"π   CASE "V": CALL SBPlay(1, "F", 4): xpos = 18: char$ = "F"π   CASE "B": CALL SBPlay(1, "G", 4): xpos = 21: char$ = "G"π   CASE "N": CALL SBPlay(1, "A", 4): xpos = 24: char$ = "A"π   CASE "M": CALL SBPlay(1, "B", 4): xpos = 27: char$ = "B"π   CASE "A": CALL SBPlay(2, "C", 5): xpos = 30: char$ = "C"π   CASE "S": CALL SBPlay(2, "D", 5): xpos = 33: char$ = "D"π   CASE "D": CALL SBPlay(2, "E", 5): xpos = 36: char$ = "E"π   CASE "F": CALL SBPlay(2, "F", 5): xpos = 40: char$ = "F"π   CASE "G": CALL SBPlay(2, "G", 5): xpos = 43: char$ = "G"π   CASE "H": CALL SBPlay(2, "A", 5): xpos = 46: char$ = "A"π   CASE "J": CALL SBPlay(2, "B", 5): xpos = 49: char$ = "B"π   CASE "Q": CALL SBPlay(3, "C", 6): xpos = 52: char$ = "C"π   CASE "W": CALL SBPlay(3, "D", 6): xpos = 55: char$ = "D"π   CASE "E": CALL SBPlay(3, "E", 6): xpos = 58: char$ = "E"π   CASE "R": CALL SBPlay(3, "F", 6): xpos = 62: char$ = "F"π   CASE "T": CALL SBPlay(3, "G", 6): xpos = 65: char$ = "G"π   CASE "Y": CALL SBPlay(3, "A", 6): xpos = 68: char$ = "A"π   CASE "U": CALL SBPlay(3, "B", 6): xpos = 71: char$ = "B"π   CASE "I": CALL SBPlay(3, "C", 7): xpos = 74: char$ = "C"π   CASE "1": CALL SBDrum(1)π   CASE "2": CALL SBDrum(2)π   CASE "3": CALL SBDrum(3)π   CASE "4": CALL SBDrum(4)π   CASE "5": CALL SBDrum(5)π   CASE "6": tst = tst + 1: IF tst > 1 THEN tst = 0π   CASE "7": vst = vst + 1: IF vst > 1 THEN vst = 0π   CASE "8": dcay = dcay + 1: IF dcay > &HF THEN dcay = 0π   CASE ";": CALL ScaleπEND SELECTππIF INSTR(" ZXCVBNMASDFGHJQWERTYUI678", key$) > 1 THENπ   COLOR 3π   IF tst = 1 THEN tst$ = "ON " ELSE tst$ = "OFF"π   IF vst = 1 THEN vst$ = "ON " ELSE vst$ = "OFF"π   LOCATE 5, 4: PRINT "Tremolo: "; tst$π   LOCATE 6, 4: PRINT "Vibrato: "; vst$π   LOCATE 5, 69: PRINT "Decay: "; HEX$(dcay)π   IF xold <> 0 THEN LOCATE 26, xold: COLOR 11: PRINT ochar$π   IF xpos <> 0 THEN LOCATE 26, xpos: COLOR 4: PRINT char$π   ochar$ = char$: xold = xposπEND IFπLOOP WHILE key$ <> "0"πCOLOR 11πEND SUBππFUNCTION note% (n$)π'These appear to be the correct frequency numbersπIF n$ = "C" THEN note% = &H209πIF n$ = "C#" THEN note% = &H219πIF n$ = "D" THEN note% = &H229πIF n$ = "D#" THEN note% = &H23BπIF n$ = "E" THEN note% = &H24EπIF n$ = "F" THEN note% = &H261πIF n$ = "F#" THEN note% = &H277πIF n$ = "G" THEN note% = &H28DπIF n$ = "G#" THEN note% = &H2A4πIF n$ = "A" THEN note% = &H2BDπIF n$ = "A#" THEN note% = &H2D8πIF n$ = "B" THEN note% = &H2F4πEND FUNCTIONππFUNCTION offset1 (channel)π'These are the offsets for each of the nine channelsπ'For operator number 1πIF channel = 1 THEN offset1 = &H0πIF channel = 2 THEN offset1 = &H1πIF channel = 3 THEN offset1 = &H2πIF channel = 4 THEN offset1 = &H8πIF channel = 5 THEN offset1 = &H9πIF channel = 6 THEN offset1 = &HAπIF channel = 7 THEN offset1 = &H10πIF channel = 8 THEN offset1 = &H11πIF channel = 9 THEN offset1 = &H12πEND FUNCTIONπππFUNCTION offset2 (channel)π'These are the offsets for each of the nine channelsπ'For operator number 2πIF channel = 1 THEN offset2 = &H3πIF channel = 2 THEN offset2 = &H4πIF channel = 3 THEN offset2 = &H5πIF channel = 4 THEN offset2 = &HBπIF channel = 5 THEN offset2 = &HCπIF channel = 6 THEN offset2 = &HDπIF channel = 7 THEN offset2 = &H13πIF channel = 8 THEN offset2 = &H14πIF channel = 9 THEN offset2 = &H15πEND FUNCTIONππSUB pause (secs!)πstart! = TIMERπDO: LOOP WHILE TIMER - start! < secs!πEND SUBππSUB pressakeyπDO: LOOP WHILE INKEY$ = ""πEND SUBππSUB SBDrum (num%)πIF num% = 1 THEN CALL WriteReg(&HBD, &H21) 'HHatπIF num% = 2 THEN CALL WriteReg(&HBD, &H22) 'CymbπIF num% = 3 THEN CALL WriteReg(&HBD, &H24) 'TomTπIF num% = 4 THEN CALL WriteReg(&HBD, &H28) 'SnreπIF num% = 5 THEN CALL WriteReg(&HBD, &H30) 'BassπCALL WriteReg(&HBD, &H0)πEND SUBππSUB SBPlay (channel%, n$, Octa%)πIF Octa% = 1 THEN octave = &H21                  'These are the octave bitsπIF Octa% = 2 THEN octave = &H25πIF Octa% = 3 THEN octave = &H29πIF Octa% = 4 THEN octave = &H2DπIF Octa% = 5 THEN octave = &H31πIF Octa% = 6 THEN octave = &H35πIF Octa% = 7 THEN octave = &H39πoffs1 = offset1(channel)                         'Get offsets dependingπoffs2 = offset2(channel)                         'on channelπIF tst = 1 THEN trem = &H80 ELSE trem = &H0πIF vst = 1 THEN vibr = &H40 ELSE vibr = &H0ππCALL WriteReg(&HB0 + offs1, &H0)              'Clear previous noteπCALL WriteReg(&H20 + offs1, &H0 + trem + vibr)   'Amp/Vib/EG/KSR/Octave(0-F)πCALL WriteReg(&H40 + offs1, &HA)                 'Scale Lev/Volume(0-3F)πCALL WriteReg(&H60 + offs1, &HF0 + dcay)         'Attack/DecayπCALL WriteReg(&H80 + offs1, &H1A)                'Sustain/ReleaseπCALL WriteReg(&HA0 + offs1, note(n$))            'NoteπCALL WriteReg(&HE0 + offs1, &H0)                 'Waveform (00-03) Default 00ππCALL WriteReg(&H20 + offs2, &H0 + trem + vibr)   'Amp/Vib/EG/KSR/Octave(0-F)πCALL WriteReg(&H40 + offs2, &HA)                 'Scale Lev/Volume(0-3F)πCALL WriteReg(&H60 + offs2, &HF0 + dcay)         'Attack/DecayπCALL WriteReg(&H80 + offs2, &H1A)                'Sustain/ReleaseπCALL WriteReg(&HB0 + offs1, octave)              'Octave(21-39)πCALL WriteReg(&HE0 + offs2, &H0)                 'Waveform (00-03) Default 00πEND SUBππSUB ScaleπFOR octave = 1 TO 7πCALL SBPlay(3, "C", octave): pause .1πCALL SBPlay(1, "C#", octave): pause .1πCALL SBPlay(2, "D", octave): pause .1πCALL SBPlay(3, "D#", octave): pause .1πCALL SBPlay(1, "E", octave): pause .1πCALL SBPlay(2, "F", octave): pause .1πCALL SBPlay(3, "F#", octave): pause .1πCALL SBPlay(1, "G", octave): pause .1πCALL SBPlay(2, "G#", octave): pause .1πCALL SBPlay(3, "A", octave): pause .1πCALL SBPlay(1, "A#", octave): pause .1πCALL SBPlay(2, "B", octave): pause .1πNEXT octaveπEND SUBππDEFSNG A-ZπSUB WriteReg (Reg%, value%)πOUT StatusP, Reg%           'Register to write at port &H388πFOR lp = 1 TO 6             'Wait 3.3 msecπwat = INP(&H388)πNEXT lpπOUT DataP, value%           'Now write data to port &H389πFOR lp = 1 TO 35            'Now wait 23 msecπwat = INP(&H389)πNEXT lpπEND SUBππCharles Godard                 PERCENT BOX                    FidoNet QUIK_BAS Echo          06-22-96 (00:00)       QB, QBasic, PDS        149  4264     PERCENT.BAS 'Percent.bas by Charles Godard 06/22/96π'Opens, maintains, then closes a popup box to be used whenπ'copying a file or performing other task, to pacify the userπ'while he waits.ππ'Switch% = 0 turns it onπ'Switch% = 1 maintains itπ'Switch% = 2 closes itπ'Pass to it, a number between 1 and 100 and the proper switchπ'PercentBox 0, 0  'you must 1st open the boxπ'PercentBox 1, (Percent%) 'maintain it with this.  Percent%π'    MUST be in parenthesis or else MUST be a numeric value.π'PercentBox 2, 0 'close it with thisπ'give it a number between 0 and 100, and increment it as neededπ'the delay's, STEP, and for/next are for demo onlyππ'I haven't tested this except in this program.  It could need someπ'modification when run in a real program. <Oh well> :)ππ'inspired by reading in the conference.. Wellerstein to Goldbloomπ'BTW, Alex, I liked yours, never got James' to run. PB, I guess :)ππ'I feel like the shipwrecked sailor, sending messages in a bottle.π'If anyone sees this message in a bottle, I sure would like toπ'hear about it.  I've been posting messages since feb, and theπ'only response that I have gotten was the one the other day fromπ'Joe.  I'm hoping that I am now making the trip! :)ππDEFINT A-ZπDECLARE SUB printScreen (Tr, Lc, H, W, Fg, Bg)πDECLARE SUB copyScreen (Tr, Lc, H, W)πDECLARE SUB PercentBox (Switch%, Percent%)ππTYPE Sdataπ   Char  AS STRING * 1π   Attr AS STRING * 1πEND TYPEπREDIM SHARED x(25, 80) AS SdataπDIM SHARED Bg, FgπCLSπSCREEN 0π'put stuff on screenπCOLOR &H7, 1: FOR i = 292 TO 678: PRINT i; : NEXT iππPercentBox 0, 0ππDly = 1: GOSUB delayπ   FOR Percent% = 1 TO 100 STEP 9π      PercentBox 1, (Percent%)  'you can change the name ofπ      GOSUB delay               'Percent% and remove the ()π   NEXT Percent%πGOSUB delayππPercentBox 2, 0ππENDππdelay:πT& = TIMER: DO WHILE (ABS(T& - TIMER) < Dly) AND INKEY$ = "": LOOPπRETURNππSUB copyScreen (Tr, Lc, H, W)ππ'Attr = SCREEN(Tr + 1, Lc + 1, 1)π'Fg = Attr AND &HFπ'Bg = Attr \ &H10ππFOR cr = Tr TO Tr + Hπ   FOR cc = Lc TO Lc + Wπ      x(cr, cc).Char = CHR$(SCREEN(cr, cc))π      x(cr, cc).Attr = CHR$(SCREEN(cr, cc, 1))π   NEXT ccπNEXT crππEND SUBππSUB PercentBox (Switch%, Percent%)πTr = 11: Lc = 20: W = 43: H = 4: 'Fg = &H4: Bg = &H4:ππSTATIC boxOpenππSELECT CASE Switch%π  CASE IS = 0  'open the boxπ      'read data from the screenπ      CALL copyScreen(Tr, Lc, H, W)π      'put popup on screenπ      FOR cr = Tr TO Tr + Hπ            LOCATE cr, Lcπ            COLOR 4, 4π            PRINT STRING$(W, " ")π      NEXT crπ     π      boxOpen = 1π        π            'set up border stylesπ            BDRtl = 218: BDRtr = 191: BDRlc = 192: BDRrc = 217: 'cornersπ            BDRv = 179: BDRh = 196:          'horizontal, vertical sidesππ         'Bdr top leftπ         COLOR &HE, 4π         LOCATE Tr, Lc: PRINT CHR$(BDRtl);  'top lt corner BDRπ         'top BDR top horizontalπ         FOR i = Tr TO Tr + W - 2: PRINT CHR$(BDRh); : NEXT iπ         'top BDR Rt cornerπ         LOCATE Tr, Lc + W: PRINT ; CHR$(BDRtr);π         'Lt BDR verticalπ         FOR i = Tr + 1 TO Tr + H - 1: LOCATE i, Lc: PRINT CHR$(BDRv); : LOCATE i, Lc + W: PRINT CHR$(BDRv); : NEXT iπ         'bottom rt cornerπ         LOCATE Tr + H, Lc + W: PRINT CHR$(BDRrc);π         'left cornerπ         LOCATE Tr + H, Lc: PRINT CHR$(BDRlc)π         'right horizontalπ         LOCATE Tr + H, Lc + 1: FOR i = Lc TO Lc + W - 2:π         PRINT CHR$(BDRh); : NEXTππ  CASE IS = 1 'maintain boxπ         IF boxOpen = 1 THENπ             LOCATE Tr, Lc + 19: PRINT STR$(Percent%); "%"π             Percent% = (Percent% / 100) * 40π             LOCATE Tr + 2, Lc + 2: PRINT STRING$(Percent%, "█")π         END IFπ π  CASE IS = 2π      'Close PercentBoxπ      IF boxOpen = 1 THENπ       boxOpen = 0π       CALL printScreen(Tr, Lc, H, W, Fg, Bg)π      END IFπ  CASE ELSEπEND SELECTππEND SUBππSUB printScreen (Tr, Lc, H, W, Fg, Bg)ππCOLOR Fg, BgππFOR cr = Tr TO Tr + Hπ   FOR cc = Lc TO Lc + Wπ      LOCATE cr, ccπ      Attr = ASC(x(cr, cc).Attr)π      Fg = Attr AND &HFπ      Bg = Attr \ &H10π      COLOR Fg, Bgπ      PRINT x(cr, cc).Char;π   NEXT ccπNEXT crππEND SUBπDarryl Schneider               ENCODE/DECODE MESSAGE          [e-mail]            07-17-96 (19:37)       QB, QBasic, PDS        463  12945    QCODE.BAS   'QCode - Version 1.0π'π'Messages can be encoded and decodedπ'with QCode. A password is required toπ'view a message, and is specified whenπ'writing a message. Make sure everythingπ'is in the C:\ directory and you willπ'have no problem. Enjoy!π'π'Written by Darryl Schneiderπ'[e-mail]π'The QBasic Zoneπ'http://www.geocities.com/SiliconValley/8191/π'πSCREEN 12                              'set screen mode to 12 andπDEFSTR A-B, D-M, R, U                  'give some standard variableπDEFINT N-Q, S-T, V-W                   'settingsπDEFLNG X-ZππDIM CURSOR(1 TO 500)                    'draw the triangle cursorπLINE (50, 50)-(50, 66), 3πLINE (50, 50)-(66, 58), 3πLINE (50, 66)-(66, 58), 3πPAINT (55, 55), 6, 3πGET (50, 50)-(66, 66), CURSORππENTER = CHR$(13)                        'define all of the arrow keysπUP = CHR$(0) + CHR$(72)πDOWN = CHR$(0) + CHR$(80)πLEFT = CHR$(0) + CHR$(75)πRIGHT = CHR$(0) + CHR$(77)ππMAINMENU:                               'just look at the label toπCLS                                     'find out what this sectionπLINE (160, 48)-(480, 230), 11, BF       'is aboutπLINE (160, 48)-(480, 63), 12, BFπLOCATE 4, 38: COLOR 14: PRINT "QCode"πCOLOR 15πLOCATE 7, 35: PRINT "Write a message"πLOCATE 9, 35: PRINT "View a message"πLOCATE 11, 35: PRINT "About QCode"πLOCATE 13, 35: PRINT "Quit"ππMM1:                                     'write a messageπLINE (240, 70)-(270, 220), 11, BFπPUT (250, 95), CURSORπDOπA1 = INKEY$πIF A1 = ENTER THEN GOSUB WRITEMESSAGEπIF A1 = UP THEN GOSUB MM4πIF A1 = DOWN THEN GOSUB MM2πLOOPππMM2:                                     'view a messageπLINE (240, 70)-(270, 220), 11, BFπPUT (250, 126), CURSORπDOπA2 = INKEY$πIF A2 = ENTER THEN GOSUB VIEWMESSAGEπIF A2 = UP THEN GOSUB MM1πIF A2 = DOWN THEN GOSUB MM3πLOOPππMM3:                                     'go to the about screenπLINE (240, 70)-(270, 220), 11, BFπPUT (250, 159), CURSORπDOπA3 = INKEY$πIF A3 = ENTER THEN GOSUB ABOUTπIF A3 = UP THEN GOSUB MM2πIF A3 = DOWN THEN GOSUB MM4πLOOPππMM4:                                     'quitπLINE (240, 70)-(270, 220), 11, BFπPUT (250, 191), CURSORπDOπA4 = INKEY$πIF A4 = ENTER THEN GOSUB QUITπIF A4 = UP THEN GOSUB MM3πIF A4 = DOWN THEN GOSUB MM1πLOOPππWRITEMESSAGE:πCLSπMNAME = ""πMPASSWORD = ""πMESSAGE = ""πMESSAGE1 = ""πSSAVE = 0ππOPEN "C:\UNTITLED.MSG" FOR OUTPUT AS #1πWRITE #1, MPASSWORDπWRITE #1, MESSAGEπCLOSE #1ππOPEN "C:\UNTITLED.MSG" FOR OUTPUT AS #2πLINE (0, 0)-(640, 17), 12, BFπCOLOR 14πLOCATE 1, 28: PRINT "QCode - Writing a Message"πCOLOR 15πLOCATE 3, 10: INPUT "Message Name (max. 8 characters): ", MNAMEπLOCATE 4, 10: INPUT "Message Password: ", MPASSWORDπMNAME = UCASE$(MNAME)πMPASSWORD = UCASE$(MPASSWORD)           'create a message name andπWRITE #2, MPASSWORD                     'passwordπLOCATE 6, 10: PRINT "Enter Message: "πN1 = 8πN2 = 1πNEXTLETTER1:πDO                                      'message is enteredπB1 = UCASE$(INKEY$)πIF B1 = "A" THEN B2 = "^"               'these are all of the characterπIF B1 = "B" THEN B2 = "Z"               'representationsπIF B1 = "C" THEN B2 = "<"πIF B1 = "D" THEN B2 = ":"πIF B1 = "E" THEN B2 = "W"πIF B1 = "F" THEN B2 = "Y"πIF B1 = "G" THEN B2 = "~"πIF B1 = "H" THEN B2 = "#"πIF B1 = "I" THEN B2 = "N"πIF B1 = "J" THEN B2 = "F"πIF B1 = "K" THEN B2 = "I"πIF B1 = "L" THEN B2 = "."πIF B1 = "M" THEN B2 = "P"πIF B1 = "N" THEN B2 = "X"πIF B1 = "O" THEN B2 = "*"πIF B1 = "P" THEN B2 = "&"πIF B1 = "Q" THEN B2 = "V"πIF B1 = "R" THEN B2 = "H"πIF B1 = "S" THEN B2 = "C"πIF B1 = "T" THEN B2 = "-"πIF B1 = "U" THEN B2 = "%"πIF B1 = "V" THEN B2 = "L"πIF B1 = "W" THEN B2 = "E"πIF B1 = "X" THEN B2 = "A"πIF B1 = "Y" THEN B2 = "B"πIF B1 = "Z" THEN B2 = "?"πIF B1 = "1" THEN B2 = "9"πIF B1 = "2" THEN B2 = "6"πIF B1 = "3" THEN B2 = "4"πIF B1 = "4" THEN B2 = "3"πIF B1 = "5" THEN B2 = "1"πIF B1 = "6" THEN B2 = "7"πIF B1 = "7" THEN B2 = "8"πIF B1 = "8" THEN B2 = "2"πIF B1 = "9" THEN B2 = "5"πIF B1 = "." THEN B2 = "G"πIF B1 = "," THEN B2 = "$"πIF B1 = "!" THEN B2 = "("πIF B1 = "$" THEN B2 = ")"πIF B1 = "@" THEN B2 = "="πIF B1 = "-" THEN B2 = "+"πIF B1 = "*" THEN B2 = "\"πIF B1 = "?" THEN B2 = "/"πIF B1 = "0" THEN B2 = "S"πIF B1 = " " THEN B2 = " "πIF B1 = "'" THEN B2 = "K"πIF B1 = ENTER THEN GOSUB SAVEMESSAGEπLOOP UNTIL B1 <> ""πLOCATE N1, N2: PRINT B1πN2 = N2 + 1πIF N2 = 60 THENπ        N2 = 1π        N1 = N1 + 1πEND IFπMESSAGE1 = MESSAGE1 + B1             'puts all of the letters intoπMESSAGE = MESSAGE + B2               'one stringπB1 = ""πGOSUB NEXTLETTER1ππSAVEMESSAGE:πCLSπLINE (0, 0)-(640, 17), 12, BFπCOLOR 14πLOCATE 1, 28: PRINT "QCode - Writing a Message"πCOLOR 15πLOCATE 3, 10: PRINT MESSAGE1πLINE (100, 405)-(540, 440), 11, BFπLINE (100, 405)-(540, 440), 12, BπLOCATE 27, 18: PRINT "Save Message"πLOCATE 27, 36: PRINT "Print Message"πLOCATE 27, 55: PRINT "Main Menu"ππWM1:                               'saves the message in .msg formatπPUT (115, 415), CURSORπDOπE1 = INKEY$πIF E1 = ENTER THENπ              WRITE #2, MESSAGEπ              CLOSE #2π              FILENAME = "C:\" + MNAME + ".MSG"π              NAME "C:\UNTITLED.MSG" AS FILENAMEπ              CLOSE #2π              SSAVE = 1π              GOSUB WM1πEND IFπIF E1 = LEFT THENπ         LINE (115, 415)-(131, 431), 11, BFπ         GOSUB WM3πEND IFπIF E1 = RIGHT THENπ         LINE (115, 415)-(131, 431), 11, BFπ         GOSUB WM2πEND IFπLOOPππWM2:                                'prints the messageπPUT (260, 415), CURSORπDOπE2 = INKEY$πIF E2 = ENTER THENπ         LPRINT "QCode Message"π         LPRINT ""π         IF SSAVE = 1 THEN LPRINT "File: "; FILENAMEπ         LPRINT ""π         LPRINT "Original Message:"π         LPRINT ""π         LPRINT "   "; MESSAGE1π         LPRINT ""π         LPRINT "Coded Message:"π         LPRINT ""π         LPRINT "   "; MESSAGEπ         LPRINT ""π         LPRINT ""π         LPRINT "QCode was written by Darryl Schneider"π         LPRINT ""π         LPRINT ""π         LPRINT ""π         GOSUB WM2πEND IFπIF E2 = LEFT THENπ         LINE (260, 415)-(276, 431), 11, BFπ         GOSUB WM1πEND IFπIF E2 = RIGHT THENπ         LINE (260, 415)-(276, 431), 11, BFπ         GOSUB WM3πEND IFπLOOPππWM3:                                     'return to main menuπPUT (412, 415), CURSORπDOπE3 = INKEY$πIF E3 = ENTER THENπ         IF SSAVE = 0 THENπ                CLOSE #2π                KILL "C:\UNTITLED.MSG"π         END IFπ         GOSUB MAINMENUπEND IFπIF E3 = LEFT THENπ         LINE (412, 415)-(428, 431), 11, BFπ         GOSUB WM2πEND IFπIF E3 = RIGHT THENπ         LINE (412, 415)-(428, 431), 11, BFπ         GOSUB WM1πEND IFπLOOPππVIEWMESSAGE:πCLSπN3 = 8πN4 = 1πN5 = 8πN6 = 1πMNAME = ""πMPASSWORD = ""πMESSAGE = ""πMP1 = ""πMP2 = ""ππLINE (0, 0)-(640, 17), 12, BFπCOLOR 14πLOCATE 1, 28: PRINT "QCode - Viewing a Message"πCOLOR 15πLOCATE 3, 10: INPUT "Message Name (max. 8 characters): ", DNAMEπLOCATE 4, 10: INPUT "Message Password: ", DPASSWORDπDNAME = UCASE$(DNAME)πDPASSWORD = UCASE$(DPASSWORD)πJFILE = "C:\" + DNAME + ".MSG"πOPEN JFILE FOR INPUT AS #3              'opens a QCode file forπINPUT #3, MPASSWORD                     'viewingππVIEWME:πLOCATE 6, 10: PRINT "Message: "; JFILEπINPUT #3, MESSAGEπY = LEN(MESSAGE)πS = 1πIF DPASSWORD = MPASSWORD THEN                'if password is correct,π        DO                                   'displays decoded messageπ        B3 = MID$(MESSAGE, S, 1)π        IF B3 = "^" THEN B4 = "A"            'these are all of theπ        IF B3 = "Z" THEN B4 = "B"            'character representationsπ        IF B3 = "<" THEN B4 = "C"π        IF B3 = ":" THEN B4 = "D"π        IF B3 = "W" THEN B4 = "E"π        IF B3 = "Y" THEN B4 = "F"π        IF B3 = "~" THEN B4 = "G"π        IF B3 = "#" THEN B4 = "H"π        IF B3 = "N" THEN B4 = "I"π        IF B3 = "F" THEN B4 = "J"π        IF B3 = "I" THEN B4 = "K"π        IF B3 = "." THEN B4 = "L"π        IF B3 = "P" THEN B4 = "M"π        IF B3 = "X" THEN B4 = "N"π        IF B3 = "*" THEN B4 = "O"π        IF B3 = "&" THEN B4 = "P"π        IF B3 = "V" THEN B4 = "Q"π        IF B3 = "H" THEN B4 = "R"π        IF B3 = "C" THEN B4 = "S"π        IF B3 = "-" THEN B4 = "T"π        IF B3 = "%" THEN B4 = "U"π        IF B3 = "L" THEN B4 = "V"π        IF B3 = "E" THEN B4 = "W"π        IF B3 = "A" THEN B4 = "X"π        IF B3 = "B" THEN B4 = "Y"π        IF B3 = "?" THEN B4 = "Z"π        IF B3 = "9" THEN B4 = "1"π        IF B3 = "6" THEN B4 = "2"π        IF B3 = "4" THEN B4 = "3"π        IF B3 = "3" THEN B4 = "4"π        IF B3 = "1" THEN B4 = "5"π        IF B3 = "7" THEN B4 = "6"π        IF B3 = "8" THEN B4 = "7"π        IF B3 = "2" THEN B4 = "8"π        IF B3 = "5" THEN B4 = "9"π        IF B3 = "S" THEN B4 = "0"π        IF B3 = "G" THEN B4 = "."π        IF B3 = "$" THEN B4 = ","π        IF B3 = "(" THEN B4 = "!"π        IF B3 = ")" THEN B4 = "$"π        IF B3 = "=" THEN B4 = "@"π        IF B3 = "+" THEN B4 = "-"π        IF B3 = "\" THEN B4 = "*"π        IF B3 = "/" THEN B4 = "?"π        IF B3 = " " THEN B4 = " "π        IF B3 = "K" THEN B4 = "'"π        LOCATE N3, N4: PRINT B4π        MP1 = MP1 + B4π        N4 = N4 + 1π        S = S + 1π                IF N4 = 60 THENπ                        N4 = 1π                        N3 = N3 + 1π                END IFπ        LOOP UNTIL S = Y + 1πEND IFππIF NOT DPASSWORD = MPASSWORD THEN          'if password is incorrect,π        DO                                 'displays encoded messageπ        B5 = MID$(MESSAGE, S, 1)π        LOCATE N5, N6: PRINT B5π        MP2 = MP2 + B5π        N6 = N6 + 1π        S = S + 1π                IF N6 = 60 THENπ                        N6 = 1π                        N5 = N5 + 1π                END IFπ        LOOP UNTIL S = Y + 1πEND IFπ       πCLOSE #3ππLINE (170, 405)-(470, 440), 11, BFπLINE (170, 405)-(470, 440), 12, BπLOCATE 27, 28: PRINT "Print Message"πLOCATE 27, 48: PRINT "Main Menu"ππVM1:                                     'prints the messageπPUT (195, 415), CURSORπDOπE4 = INKEY$πIF E4 = ENTER THENπ         LPRINT "QCode Message"π         LPRINT ""π         IF SSAVE = 1 THEN LPRINT "File: "; FILENAMEπ         LPRINT ""π         LPRINT "Original Message:"π         LPRINT ""π         IF MP1 <> "" THEN LPRINT "   "; MP1π         IF MP2 <> "" THEN LPRINT "    Sorry, you need the password!"π         LPRINT ""π         LPRINT "Coded Message:"π         LPRINT ""π         LPRINT "   "; MESSAGEπ         LPRINT ""π         LPRINT ""π         LPRINT "QCode was written by Darryl Schneider"π         LPRINT ""π         LPRINT ""π         LPRINT ""π         GOSUB VM1πEND IFπIF E4 = LEFT THENπ         LINE (195, 415)-(211, 431), 11, BFπ         GOSUB VM2πEND IFπIF E4 = RIGHT THENπ         LINE (195, 415)-(211, 431), 11, BFπ         GOSUB VM2πEND IFπLOOPππVM2:                                    'returns to main menuπPUT (355, 415), CURSORπDOπE5 = INKEY$πIF E5 = ENTER THENπ         GOSUB MAINMENUπEND IFπIF E5 = LEFT THENπ         LINE (355, 415)-(371, 431), 11, BFπ         GOSUB VM1πEND IFπIF E5 = RIGHT THENπ         LINE (355, 415)-(371, 431), 11, BFπ         GOSUB VM1πEND IFπLOOPππABOUT:                                'the infamous about screenπCLSπLINE (0, 0)-(640, 17), 12, BFπCOLOR 14πLOCATE 1, 35: PRINT "About QCode"πCOLOR 15πPRINT ""πPRINT ""πPRINT "QCode was written in Microsoft QuickBasic by Darryl Schneider. The"πPRINT "program is a message encoder/decoder. To use the program, first write"πPRINT "a message. All message files are saved to the C:\ drive. The message"πPRINT "name that you choose can be a maximum of 8 characters. No file extension"πPRINT "or drive specification is required in the message name. The password"πPRINT "is the key to opening the message. You must know the password to that"πPRINT "particular message in order to decode it. Once you have finished writing"πPRINT "the message, you may view it by selecting the option at the main menu."πPRINT "Then just type in the message name and the password for that message,"πPRINT "and it will be decoded. I included a print option so you can print"πPRINT "out each of the messages. I hope you like the program. Enjoy!"πPRINT ""πPRINT "Darryl Schneider"πPRINT "[e-mail]"πPRINT "The QBasic Zone"πPRINT "http://www.geocities.com/SiliconValley/8191/"ππLINE (270, 405)-(370, 440), 11, BF          'draw the box at theπLINE (270, 405)-(370, 440), 12, B           'bottom of the screenπLOCATE 27, 38: PRINT "Main Menu"ππPUT (275, 415), CURSORπDOπG1 = INKEY$πIF G1 = ENTER THEN GOSUB MAINMENU           'return to the main menuπLOOPππQUIT:πENDππ'End of QCodeπJonathan Leger                 FAST PRINT REPLACEMENT         [e-mail]             08-01-96 (11:34)       QB, QBasic, PDS        230  9505     XPRINT.BAS  ' This is a TWO part snippet (XPRINT.BAS and XPRINT.8 to follow)ππ'******************π'*** XPRINT.BAS ***π'****************************************************************************π'*** This program will demonstrate the superior speed of Xprint over      ***π'*** Qbasic and QuickBASIC's PRINT, COLOR and LOCATE statements.          ***π'*** Xprint is typically about 350% - 400% faster than Qbasic and from    ***π'*** 30% - 60% faster than QuickBASIC.                                    ***π'***                                                                      ***π'*** HOWEVER!  Please note that Xprint() performs _no_ error checking     ***π'*** except for making sure the string is longer than 0 bytes, while      ***π'*** QuickBASIC wont let you print off the screen, etc.  If this program  ***π'*** did that error checking, it would be as slow as QuickBASIC, which    ***π'*** would defeat the purpose! Absence of this error checking is not      ***                                         π'*** dangerous unless you're printing a string that's longer than 16,000  ***π'*** bytes to the screen (and I'm not even sure if that's completely      ***π'*** dangerous...), which will go outside the bounds of your screen       ***π'*** memory.  Anyone, however, who would do this is clearly not too swift ***π'*** (mentally speaking) and probably needs to have his computer crash on ***π'*** him every now and again to wake him up.                              ***π'****************************************************************************π'*** This demonstration program and the Xprint() routines were written by ***π'*** Jonathan Leger ([e-mail]), and may be freely distributed   ***π'*** to anybody.  These routines are 100% absolutely no lies or nothin'   ***π'*** FREE to the general public.  You can send me e-mail to praise my     ***π'*** genious if you want, but I require nothing more. *grin*              ***π'****************************************************************************ππDEFINT A-Zππ'*** The declaration of Absolute() is required for QB, which must be loadedπ'*** with "/L QB" for it to work.  The declartion in Qbasic is optional.πDECLARE SUB Absolute (arg1%, arg2%, arg3%, arg4%, arg5%, arg6%, arg7%, offset%)ππ'*** readyXprint() stores the machine language Xprint() routine, and must beπ'*** called before using the Xprint.  Note, though, that it only needs to beπ'*** called _once_.πDECLARE SUB readyXprint ()ππ'*** The actual Xprint() routine.  Prints s$ to coordintes (x%,y%) on theπ'*** screen in color fore%, back%.  Notice, though, that to keep the feelπ'*** of BASIC's LOCATE, which is in the format LOCATE Y, X, the Y precedesπ'*** the X in the Xprint() routine also.πDECLARE SUB Xprint (s$, y%, x%, fore%, back%)ππ'*** This sub is used only in the demonstration, so you can trash it if youπ'*** don't want it.πDECLARE SUB testXprint ()ππSCREEN 0πWIDTH 80, 25ππreadyXprint       'This routine must be called before using Xprint!π                  'You only have to call it once though. :)ππtestXprint        'Lessee some comparisons...ππDEFSNG A-Zπ'**********************π'*** readyXprint()    *π'**************************************************************************π'*** This routine loads the xprint machine-language program into the    ***π'*** xprint.asm$ string for use by the Xprint() routine.  This program  ***π'*** _must_ be called before using the Xprint() routine, or the program ***π'*** will crash!                                                        ***π'**************************************************************************π'*** All questions and comments welcome.  Send inquries to the me at    ***π'*** [e-mail]                                                 ***π'**************************************************************************πSUB readyXprintππSHARED asm$ππ'*** This is the actual X-print program.π'*** It was written using A86--a truly beautiful assembler!ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(131)πasm$ = asm$ + CHR$(126) + CHR$(10) + CHR$(0) + CHR$(116) + CHR$(66)πasm$ = asm$ + CHR$(139) + CHR$(126) + CHR$(14) + CHR$(131) + CHR$(239)πasm$ = asm$ + CHR$(1) + CHR$(137) + CHR$(251) + CHR$(193) + CHR$(231)πasm$ = asm$ + CHR$(7) + CHR$(193) + CHR$(227) + CHR$(5) + CHR$(3)πasm$ = asm$ + CHR$(251) + CHR$(131) + CHR$(110) + CHR$(12) + CHR$(1)πasm$ = asm$ + CHR$(209) + CHR$(102) + CHR$(12) + CHR$(3) + CHR$(126)πasm$ = asm$ + CHR$(12) + CHR$(139) + CHR$(86) + CHR$(18) + CHR$(193)πasm$ = asm$ + CHR$(226) + CHR$(4) + CHR$(3) + CHR$(86) + CHR$(16)πasm$ = asm$ + CHR$(30) + CHR$(142) + CHR$(94) + CHR$(8) + CHR$(139)πasm$ = asm$ + CHR$(118) + CHR$(6) + CHR$(80) + CHR$(184) + CHR$(0)πasm$ = asm$ + CHR$(184) + CHR$(142) + CHR$(192) + CHR$(88) + CHR$(139)πasm$ = asm$ + CHR$(78) + CHR$(10) + CHR$(138) + CHR$(4) + CHR$(38)πasm$ = asm$ + CHR$(136) + CHR$(5) + CHR$(38) + CHR$(136) + CHR$(85)πasm$ = asm$ + CHR$(1) + CHR$(70) + CHR$(71) + CHR$(71) + CHR$(226)πasm$ = asm$ + CHR$(242) + CHR$(31) + CHR$(93) + CHR$(203)ππEND SUBππDEFINT A-ZπSUB testXprintππLOCATE , , 0πCLSππLOCATE 1, 1πCOLOR 7, 0πPRINT "XPRINT"ππt.xprint# = TIMERπFOR redraw = 1 TO 100π   back = INT(RND * 7) + 1π   FOR y = 2 TO 25π       Xprint STRING$(80, " "), y, 1, 7, backπ   NEXT yπNEXT redrawπt.xprint# = TIMER - t.xprint#ππCLSπLOCATE 1, 1πCOLOR 7, 0πPRINT "BASIC"πt.basic# = TIMERπFOR redraw = 1 TO 100π   COLOR 7, INT(RND * 7) + 1π   FOR y = 2 TO 25π      LOCATE y, 1π      PRINT STRING$(80, " ");π   NEXT yπNEXT redrawπt.basic# = TIMER - t.basic#ππCOLOR , 0πCLSπPRINT "XPrint redrew the screen 100 times in"; t.xprint#; "seconds."πPRINT "BASIC redrew the screen 100 times in"; t.basic#; "seconds."πPRINTπPRINT "XPrint was approximately"; INT((t.basic# / t.xprint#) * 100); "% faster."πEND SUBππ'*****************π'*** Xprint()    *π'**************************************************************************π'*** Arguments:                                                         ***π'***     s$       =     string to print                                 ***π'***     y%       =     line to print at                                ***π'***     x%       =     column to print at                              ***π'***     fore%    =     foreground color (normal BASIC numbering used)  ***π'***     back%    =     background color (normal BASIC numbering used)  ***π'**************************************************************************π'*** This routine was written by Jonathan Leger ([e-mail])    ***π'*** using the A86 assembler.  The assembly-language file can be viewed ***π'*** for further study (XPRINT.8).                                      ***π'**************************************************************************π'*** All questions and comments welcome.  Send inquries to the above    ***π'*** e-mail address.                                                    ***π'**************************************************************************πSUB Xprint (s$, y%, x%, fore%, back%)ππSHARED asm$ππDEF SEG = VARSEG(asm$)π   CALL Absolute(BYVAL back%, BYVAL fore%, BYVAL y%, BYVAL x%, BYVAL LEN(s$), BYVAL VARSEG(s$), BYVAL SADD(s$), SADD(asm$))πDEF SEGππEND SUBππ;--------------------8<----[ Begin XPRINT.8 ]---->8---------------------ππ;*** Xprint for BASIC.π;*** Prints a string to coordintes y%, x%, with color f%, b%, real fast. :)π;*** call like this:π;***π;*** Call Absolute (b%, f%, y%, x%, len(s$), sadd(s$), varptr(s$), offset%)π;***π;*** WARNING:  This routine does _no_ error checking to see if you're goingπ;***           off-screen with the string (for speed purposes), so pleaseπ;***           be sure to check that in your program!ππPUSH BP     ;preserve BP!πMOV BP,SPππSTRUC [BP]π  JUNK1   DW  ?π  JUNK2   DW  ?π  JUNK3   DW  ?             ;the junk we don't need!π  STR_OFF DW  ?             ;our string pointer [bp+6]π  STR_SEG DW  ?             ;our string segment [bp+8]π  LEN     DW  ?             ;our string length [bp+0a]π  X       DW  ?             ;our x location [bp+0c]π  Y       DW  ?             ;our y location [bp+0e]π  FORE    DW  ?             ;foreground color [bp+10]π  BACK    DW  ?             ;background color [bp+12]πENDSππCMP LEN,00πJE DoneππMOV DI,Y                    ;get the offset for the starting characterπSUB DI,1                    ;using the formula:πMOV BX,DI                   ;     ( ( ( Y - 1 ) * 80 ) + X )πSHL DI,7πSHL BX,5πADD DI,BXπSUB X,1πSHL X,1πADD DI,X                    ;DI now contains the starting offset.ππMOV DX,BACK                 ;calculate the color value using the formula:πSHL DX,4                    ;     ( FOREGROUND + ( BACKGROUND * 16 ) )πADD DX,FOREππPUSH DSππMOV DS,STR_SEG              ;string segmentπMOV SI,STR_OFF              ;string offsetπMOV ES,0B800                ;screen offset for color scren 0πMOV CX,LENππPrintChar:πMOV AL,DS:[SI]              ;put next character into ALπMOV ES:B[DI],AL             ;write it to screenπMOV ES:B[DI+1],DL           ;write color value to screenπINC SI                      ;next characterπINC DI,2                    ;next screen coordinateπLOOP PrintCharππDone:ππPOP DS                     ;restore DS for BASICπPOP BP                     ;restore BP for BASICπRETF                       ;return to BASIC!πKurt Kuzba                     LINE INPUT REPLACEMENT         FidoNet QUIK_BAS Echo          03-21-96 (00:00)       QB, QBasic, PDS        82   3422     ELVIS.BAS   '>   Is here a way to get rig of cntrl-break?π'>................π'   Use INKEY$ instead of INPUT. Have a look at this.π'_|_|_|   ELVIS.BASπ'_|_|_|   This program allows the input of 'larger than life'π'_|_|_|   strings with limited editing windows on the screen.π'_|_|_|   BACKSPACE, HOME, END, LEFT, RIGHT, INSERT, DELETE,π'_|_|_|   and ESCAPE are all active in the input routine.π'_|_|_|   No warrantees or guarantees are given or implied.π'_|_|_|   Released to   PUBLIC DOMAIN   by Kurt Kuzba.  (3/21/96)πDECLARE SUB Elvus (prompt$, max%, winsiz%, S$, sequins%)πDECLARE FUNCTION Elvis$ (prompt$, max%, winsiz%, S$, sequins%)πPRINTπPath$ = "C:\": p$ = "Please Enter Your Path =>"πMystr$ = Elvis$(p$, 32, 8, Path$, 0)πPRINT : PRINT UCASE$(Path$): PRINT Mystr$πPass$ = "": p$ = "Please Enter Your Password =>"πMystr$ = Elvis$(p$, 32, 8, Pass$, 1)πPRINT : PRINT UCASE$(Pass$): PRINT Mystr$πIF Mystr$ <> "friend" THEN PRINT "Wrong Password":  ELSE PRINT "OK"πFUNCTION Elvis$ (prompt$, max%, winsiz%, S$, sequins%)π   Elvus prompt$, max%, winsiz%, S$, sequins%: Elvis$ = S$πEND FUNCTIONπSUB Elvus (prompt$, max%, winsiz%, S$, sequins%)π   S$ = LTRIM$(RTRIM$(S$)): Cursor% = LEN(S$) - (Cursor% < max%)π   F$ = "_": IF sequins% <> 0 THEN F$ = " "π   Fill$ = STRING$(max%, F$)π   S$ = LEFT$(S$ + Fill$, max%): INS% = -1: PRINT prompt$; " ";π   Ybase% = POS(0)π   WHILE done$ <> "DONE"π      Sbase% = Cursor% - winsiz% + 1: IF Sbase% < 1 THEN Sbase% = 1π      LOCATE , Ybase%, 0: Hid$ = STRING$(LEN(RTRIM$(S$)), "*")π      IF sequins% = 0 THENπ         PRINT MID$(S$ + Fill$, Sbase%, winsiz%); " ";π      ELSEπ         PRINT MID$(Hid$ + Fill$, Sbase%, winsiz%); " ";π      END IFπ      LOCATE , Ybase% + Cursor% - Sbase%, 1π      k$ = "": WHILE k$ = "": k$ = INKEY$: WENDπ      k% = ASC(k$): IF k% = 0 THEN k% = -ASC(MID$(k$, 2))π      SELECT CASE k%π         CASE 32 TO 127π            IF INS% AND Cursor% < max% THENπ               MID$(S$, Cursor% + 1) = MID$(S$, Cursor%)π               S$ = LEFT$(S$, max%)π            END IFπ            MID$(S$, Cursor%, 1) = k$π            IF Cursor% = max% THEN SOUND 999, 1π            Cursor% = Cursor% - (Cursor% < max%)π         CASE 13: IF S$ = Fill$ THEN S$ = ""π            IF INSTR(S$, F$) > 0 THEN S$ = LEFT$(S$, INSTR(S$, F$) - 1)π            EXIT SUBπ         CASE 8π            IF Cursor% > 1 THENπ               Cursor% = Cursor% - 1π               MID$(S$, Cursor%) = MID$(S$, Cursor% + 1)π               MID$(S$, max%) = F$π            ELSEπ               SOUND 999, .7π            END IFπ         CASE 27: S$ = "": EXIT SUBπ         CASE -71: Cursor% = 1π         CASE -79: Cursor% = INSTR(S$, F$)π            IF Cursor% = 0 THEN Cursor% = max%π         CASE -82: INS% = -(INS% + 1): SOUND 1500 + 800 * INS%, .5π         CASE -83π            IF Cursor% < max% THENπ               MID$(S$, Cursor%) = MID$(S$, Cursor% + 1)π               MID$(S$, max%) = F$π            ELSEπ               SOUND 999, .7π            END IFπ         CASE -75: Cursor% = Cursor% - 1π            lim% = INSTR(S$, F$): lim% = lim% - max% * (lim% = 0)π            IF Cursor% < 1 THEN Cursor% = lim%π         CASE -77: Cursor% = Cursor% + 1π            lim% = INSTR(S$, F$): lim% = lim% - max% * (lim% = 0)π            IF Cursor% > lim% THEN Cursor% = 1π      END SELECTπ   WENDπEND SUBπ'_|_|_|   end   ELVIS.BASπ 1         73   BRESENHAM LINE/CIRCLE ALGORITHMKurt Kuzba                      2407      47   BASE CONVERSION ROUTINE        Tyler Barnes                    4184      133  PB HUFFMAN ENCODER             M. Rosenberg                    8975      17   NUMBER OF POSSIBLE COMBINATIONSFranklin Villamor               1         32   ENVIRONMENT PATHNAME           Stuart McLachlan                1         116  DEBUG ASM CONVERTER            Daniel Garlans                  1         761  ENIGMA CODING PROGRAM          Paul Kuliniewicz                26399     168  XOR ENCRYPTION/DECRYPTION      Jonathan Leger                  32768     44   8-BIT TO 6-BIT ENCODER/DECODER Kurt Kuzba                      1         68   CHANGE FREQ OF SYSTEM TIMER    Edward Di Geronimo Jr.          2445      64   LINEAR DATE                    Kevin J. Krumwiede              4380      225  CONTINUALLY DISPLAY ACTUAL TIMEEgbert Zijlema                  11484     99   TRAP KEYBOARD INACTIVITY       Egbert Zijlema                  1         94   SPACE SHOWER DEMO              Erik Bruggema                   1         37   FIND AVAILABLE BYTES ON DRIVE  Peter Norton                    1         154  BATCH PROCEDURES               Edward Blake                    5065      56   FILE HANDLES                   Joe Negron                      6919      76   READING FILES FROM DIRECTORY   Ronald Kas                      1         194  ETCH-A-SKETCH                  Steven Anthony Morisi           3549      48   WRITING PIXELS IN MODE 12H     Kurt Kuzba                      5695      259  GUI PROGRAMMER'S LIBRARY V1.23 Tika Carr                       12493     179  QUICK MAZE MAKER               Kris Reeves                     23734     156  DRAW A CADIOID (DAISY)         Don Schullian/Jim Oliver        1         15   GET BACK TO ROOT DIRECTORY     Scott Turchin                   627       816  FORMAT OF GRASP ANIMATION FILE George Phillips                 1         382  MONOPOLY (LIKE THE BOARD GAME) Paul Kuliniewicz                25065     539  QBASIC PCMAN                   Akarsha Vasant Kumar            43181     338  QBASIC ROAD RACER              Akarsha Vasant Kumar            52881     115  SOLO DOGFIGHTING               David Zohorb                    60486     809  LEAPGUY                        Steven Hanov                    91088     375  HANG PERSON                    Steven Hanov                    104360    112  PICK A NUMBER                  Steven Hanov                    109932    414  TOAD HOP (FROGGER CLONE)       The ABC Programmer              123754    142  AVOID BLUE MEANIES             Kurt Kuzba                      129550    753  PACMAN LIVES!                  Steven Hanov                    150345    402  SUPER GALATIC WARS             Robert Anthony Moreno           161069    1022 HEX-ALIGN 4X4 PUZZEL           Jonathan Leger                  190451    1430 WORLD CUP SOCCER '94           Alex Makris                     251733    431  SPACE MAN FRED                 Ben Kington                     260664    90   MATHEMATICAL WORMS OF XANTHE   James McMurrin                  266647    1068 FEDERATION DEFENDER            Richard Hilsden                 298122    1102 MINESWEEPER FOR DOS            Akarsha Vasant Kumar            1         55   STAR TREK COMMUNICATOR PIN     Andy J. Golden                  1958      50   SCROLLING CELL MAP             Steven Sensarn                  5300      198  SCREEN ART/SAVER               Scott Tuttle                    12083     476  MODE-X MANDELBROT SET          Erika Schulze                   43149     204  FAST MEMCOPY ROUTINE           Jonathan Leger                  53509     86   GROWING FIRE                   Tony Lieuallen                  55641     26   CHAOS                          Andy J. Golden                  56345     26   FRACTAL FERN                   Andy J. Golden                  57050     71   PUT W/O ERASING BACKGROUND     Chad Beck                       60235     72   HAPPY TRAILZ                   Kurt Kuzba                      63235     86   ROTATING A BIG PALETTE SMOOTHLYKurt Kuzba                      66643     184  320X240 MODEX WITH 3 PAGES     Douglas Lusher                  72452     114  PROG-DRAW 2.2                  Ben Lloyd                       79908     218  BURNING FIRE SIMULATOR         Tony Cave                       87108     77   BOUNCING GREAT BALLS OF FIRE   Kurt Kuzba                      90294     66   BUFFERED PCX VIEWER            Kurt Kuzba                      92959     59   DONUT BALLS                    Darryl Stokes                   94234     86   PALETTE MANIPULATION           Kurt Kuzba                      98346     93   RAY CASTER 3D ENGINE           Peter Cooper                    101123    274  LED SCREEN SAVER               Jonathan Leger                  109817    486  ICON MAKER V1.0                Claude Gagné                    121154    137  ANIMATION FACTORY V1.0         Gerald Filimonov                130029    519  RAY CASTER WITH KEYBOARD ISR   Steven Sensarn                  150053    519  HIGHSPEED RAYCASTING FOR PB    Thomas Gohel                    164337    59   BURNING TEXT                   Andrew L. Ayers                 166118    39   STEEL PRINT                    Andrew L. Ayers                 167266    120  PSYCHO PRINT                   Andrew L. Ayers                 170808    88   FAST VGA SCROLL                Andrew L. Ayers                 173978    123  BIG TEXT SCROLL                Andrew L. Ayers                 177366    129  VGA PALETTE READ/WRITE ROUTINESAndrew L. Ayers                 181064    175  VGA SINUSOIDAL PLASMA          Andrew L. Ayers                 185941    222  CLOUD PLASMA EFFECT            Andrew L. Ayers                 192111    93   BUFFER TO SCREEN COPY ROUTINE  Andrew L. Ayers                 196276    32   USING GET & PUT                Kurt Kuzba                      198244    935  GRAPHICS LOADER                Jonathan Leger                  223721    223  2D POLYGON ENGINE              Brent P. Newhall                229316    197  VARIABLE PLASMA EFFECT         Kurt Eckhardt                   235448    243  TGA VIEWER                     Erika Schulze                   245760    31   MATHEMATICAL FORMULA DISPLAYED James McMurrin                  1         313  INTERRUPT TUTOR                Tika Carr                       13065     139  INTERRUPTS IN QBASIC           Richard J. Backus               1         973  LIBERTY YAHTZEE                Chris Sugden                    1         770  PALETTE LIBRARY                Joe Lawrence                    1         357  USING EMS WITH MEMCOPY ROUTINE Jonathan Leger                  12520     50   DIFFERENCE BETWEEN SADD/VARPTR Bob Perkins                     14608     249  PB XMS ROUTINES                Erika Schulze                   1         274  OPEN UP TO 16 POPUP BOXES      Charles Godard                  8690      308  PB WINDOWS LIBRARY             Bradley Miller                  1         456  INTERNET SEARCH UTILITY        Darryl Schneider                14946     125  PROGRAM THE PARALLEL PORT      Christoph Kummetat              20019     245  BBS GAME PROGRAMMING           Robert Fortune                  28935     40   SET NEW PRINTER TIMEOUT VALUE  Rick Pedley                     1         239  ACCESSING COM PORT VIA INT 14  Robert Fortune                  10294     77   REMOTE ACCESS UTILITIES        Erik Bruggema                   1         923  PB MOUSE IMPLEMENTATION        Egbert Zijlema                  1         77   SPLIT SCREEN COLOR ATTRIBUTE   Egbert Zijlema                  1         7    HAPPY BIRTHDAY SONG            John Fischer                    433       61   MORE THEME SONGS               John Fischer                    3664      39   FLUTE BOOK MUSIC COLLECTION    Charles Godard                  5845      319  PLAY MUSICAL HELPER            John Fischer                    16209     358  ADLIB SOUND EFFECTS            Lloyd Chang                     28351     158  PLAY ADLIB                     [e-mail]                 33759     25    BOTTLES OF BEER ON THE WALL Tony Cave                       34685     332  SOUND BLASTER PIANO            Kurt Eckhardt                   1         149  PERCENT BOX                    Charles Godard                  4281      463  ENCODE/DECODE MESSAGE          Darryl Schneider                16928     230  FAST PRINT REPLACEMENT         Jonathan Leger                  26368     82   LINE INPUT REPLACEMENT         Kurt Kuzba